Help with file creaton

crackod93

Board Regular
Joined
Aug 9, 2007
Messages
71
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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

crackod93

Board Regular
Joined
Aug 9, 2007
Messages
71
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

Board Regular
Joined
Aug 9, 2007
Messages
71
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 :)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,714
Messages
5,833,281
Members
430,201
Latest member
Deepakpilla36

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top