Solved: Opening and writing to multiple ASCII text files

[RockMechMark]

I am having a challenge finding the solution here. I cannot seem to open an ASCII file for the purpose of writing contents of some cells from several worksheets within one spreadsheet file.

In the following code (with irrelevant lines not shown), I have several sheets. For each, I want to read the contents of cells and write them line by line to an ASCII file. However, if the file already exists, I do not want to create that file, but instead, move on to the next sheet. In my test case, I start with the second sheet, but that file already exists. No file yet exists from data in the third sheet.

The problem comes in the Set f = fs.OpenTextFile(Fname) line. The error is that the object does not support the method.

I wonder if the statement Set fs = CreatObject("Scripting.FileSystemObject") is a problem, being used for multiple ASCII files? What is wrong here?

Here is the code, minus the irrelevant lines:

[VBA]Sub InsertCoarseBorders()
'
' InsertCoarseBoarders Macro
'
'
Dim Fname As String, k As Integer, StepNum As String, kk As Integer
Dim FnameExists As Integer, MyStr As String, MyStr1 As String
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")
k = 2
Do While k < 4
kk = k + 134
If kk < 10 Then
StepNum = "00" & kk
Else
If kk < 100 Then
StepNum = "0" & kk
End If
If kk >= 100 Then
StepNum = kk
End If
End If
Fname = "D:\xxxxxx\yyyyyy\Coarse grids\MS_EC_" & StepNum
Fname = Fname & "Coarse.txt"
' MsgBox (Fname)
FnameExists = fs.FileExists(Fname)
If FnameExists = False Then
…
Set f = fs.CreatTextFile(Fname)
i = 1
j = 1
imax = 1370
jmax = 640
Do While i < imax
MyStr = ""
Do While j < jmax
MyStr1 = ActiveCell.Value
MyStr = MyStr & MyStr1
j = j + 1
Loop
f.WriteLine (MyStr)
i = i + 1
Loop
f.Close
End If
k = k + 1
Loop
End Sub
[/VBA]

[patel]

try this code, you can adapt it for your goal
[vba]Sub ExportToText()
Dim Fname As String, k As Integer, StepNum As String, kk As Integer
Dim FnameExists As Integer, MyStr As String, MyStr1 As String
Dim fs As Object, f As Object
Set Zona = Worksheets("Registro").UsedRange
Set fs = CreateObject("Scripting.FileSystemObject")
Fname = "D:\DATA\test\"
Fname = Fname & "test1.txt"
FnameExists = fs.FileExists(Fname)
If FnameExists = False Then
FileNum = FreeFile()
Open Fname For Output As #FileNum
If Err <> 0 Then
MsgBox "I can not open " & Fname
Exit Sub
End If
For RowCount = 1 To Zona.Rows.Count
For ColumnCount = 1 To Zona.Columns.Count
Print #FileNum, Zona.Cells(RowCount, ColumnCount).Text & " ";
If ColumnCount = Zona.Columns.Count Then
Print #FileNum,
End If
Next ColumnCount
Next RowCount
Close #FileNum
End If
End Sub[/vba]

[GTO]

Just a question reference:
[VBA]Fname = "D:\xxxxxx\yyyyyy\Coarse grids\MS_EC_" & StepNum
Fname = Fname & "Coarse.txt"
[/VBA]
Would the filename be something like "MS_EC_012Coarse.txt" ?

[snb]

Just a side note:

[vba]
msgbox format(9,"000")
msgbox format(56,"000")
msgbox format(348,"000")
[/vba]

VBA has a method to append data to a file; if the file doesn't exist it will be created, if it exists data will be added to the existing data in the file

[vba]Sub snb()
Application.DisplayAlerts = False

Sheets(1).Copy
With ActiveWorkbook.Sheets(1)
.Rows(1371).Resize(Rows.Count - 1370).Delete
.Columns(641).Resize(.Columns.Count - 640).Delete
.SaveAs "G:\OF\new.txt", xlTextMSDOS
.Parent.Close False
End With

Open "D:\xx\yy\Coarse grids\MS_EC_" & Format(kk, "000") & "Coarse.txt" For Append As #1
Print #1, CreateObject("scripting.filesystemobject").opentextfile("G:\OF\new.csv").re adall
Close
End Sub[/vba]

[RockMechMark]

Thanks to all who wrote with suggestions.

My problem was that I mistyped the function name. It was missing the second "e" in "Create".
The statement should have read
[VBA] Set f = fs.CreateTextFile(Fname)
[/VBA]
After that, the subroutine worked. However, I had to rewrite the code for assembly of the characters for the line(s) to be written to the output file(s).

To GTO: Yes, that is the structure of the output files. Always three digits before "Coarse" with leading zeros, if necessary.

To patel: Me parece que habla el español ("zona" y "registro"). Hace muchos años yo era fluido. Ahora estoy tratando de volver a recuperarlo.

Mark

[patel]

I'm italian

[RockMechMark]

Also a beautiful language.