Help with file creaton

[crackod93]

hello, so ive a piece of vb code (which ive grabbed from various other help forums) which i use to go through tabs on my excel and create text files (.json) and which then clears out empty rows which arent used. the issue is that more often than not, the files arent getting created, no errors are provided, just sometimes it works, most of the time it doesnt - anyone have any ideas??

NOTE: the way these files are created uses some specific technique to avoid doubling up things like commas and double quotes, eg in the source sheet i may have something like "hello", which when exported to csv/text file would usually come out like ""hello"",, but using this way it retains the formatting which i need

Sub generateOutput()

Application.Calculate

If MsgBox("Do you want to create the json files?", vbOKCancel) = vbCancel Then

Exit Sub

End If


If Range("export_check").Value > 0 Then

MsgBox "Errors exist, correct data and re-run"

Exit Sub

End If

Dim outputFiles(0 To 5) As String
outputFiles(0) = "file1.json"
outputFiles(1) = "file2.json"
outputFiles(2) = "file3.json"
outputFiles(3) = "file4.json"
outputFiles(4) = "file5.json"
outputFiles(5) = "file6.json"

For Each Value In outputFiles

ActiveWorkbook.Sheets(Value).Activate

Call TextNoModification(Value)
Call tidyup(Value)

Next


End Sub




Public Sub TextNoModification(ByVal filename As String)
Const DELIMITER As String = "," 'or "|", vbTab, etc.
Dim myRecord As Range
Dim myField As Range
Dim nFileNum As Long
Dim sOut As String

nFileNum = FreeFile
Open filename For Output As #nFileNum
For Each myRecord In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
With myRecord
For Each myField In Range(.Cells(1), _
Cells(.Row, Columns.Count).End(xlToLeft))
sOut = sOut & DELIMITER & myField.Text
Next myField
Print #nFileNum, Mid(sOut, 2)
sOut = Empty
End With
Next myRecord
Close #nFileNum
End Sub




Sub tidyup(ByVal filename As String)

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(filename, ForReading)

Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If Len(strLine) > 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop

objFile.Close

Set objFile = objFSO.OpenTextFile(filename, ForWriting)
objFile.Write strNewContents
objFile.Close

End Sub

 

[crackod93]

so seems the issue here is that excel is setting the save location to a random place on the machine - does anyone know how i can set the default path to the current location of where the open workbook is saved as the place where the output files is saved and how i modify the above to do this??

thanks again

 

[crackod93]

ive identified that for some reason the path these files are being saved to is sometimes randomly changing. originally it saved in the same location as the source file, then it changed to my documents for some unknown reason

have corrected this to send to c:\temp by adding

Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
SetCurrentDirectory "C:\temp"

seems to have done the trick