Loop & append to csv file

[jalea148]

I have a table starting in some row and column.
Each row starts with a date with values in the following 5 cells and a csv file name [full address] in the last column.
I'd like to loop through each row of the table appending the date and the 5 cells to the correspond files.

 

[tweedle]

This version uses generic FileSystemObjects to collect your cells and write them to the defined files. Minimal Error checking.
It prompts for the starting cell-intended to be the first date; then it will go through all entries for that column, going down the sheet.
If the output file is not found, it is created and written to.

Option Explicit

Dim fso, f, ts 'Scripting Objects
Dim start, cell As Range
Dim r, lr, wrkcol As Long
Const dlmtr = "," ' Set Delimeter
Dim tmp As String
Sub foo()
'Init Objects
Set fso = CreateObject("Scripting.FileSystemObject")

'Get the start range
    Do
        Set start = Application.InputBox("Select some row and column [Date] to start:", Type:=8)
    Loop While start Is Nothing

    'assign variable values
    wrkcol = start.Columns(1).Column
    lr = Cells(Rows.Count, wrkcol).End(xlUp).Row

    For r = start.Rows(1).Row To lr
        tmp = ""
        Set cell = Cells(r, wrkcol)
        'build a string to write
        tmp = tmp & Cells(r, wrkcol).Offset(0, 0).Value & dlmtr    'date
        tmp = tmp & Cells(r, wrkcol).Offset(0, 1).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 2).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 3).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 4).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 5).Value

        'Determine file If Exist/Else Create
        On Error Resume Next
        Set f = fso.GetFile(Cells(r, wrkcol).Offset(0, 6).Text)    'filepath
        If Err = 53 Then
            Set f = fso.CreateTextFile(Cells(r, wrkcol).Offset(0, 6).Text, False, False)     'filepath
            Set f = fso.GetFile(Cells(r, wrkcol).Offset(0, 6).Text)    'filepath
            Err = 0
        End If
        
        'open file, write and close
        Set ts = f.OpenAsTextStream(IOMode:=ForAppending)
        ts.WriteLine tmp
        ts.Close
    Next r

End Sub

 

[jalea148]

This version uses generic FileSystemObjects to collect your cells and write them to the defined files. Minimal Error checking.
It prompts for the starting cell-intended to be the first date; then it will go through all entries for that column, going down the sheet.
If the output file is not found, it is created and written to.

Option Explicit

Dim fso, f, ts 'Scripting Objects
Dim start, cell As Range
Dim r, lr, wrkcol As Long
Const dlmtr = "," ' Set Delimeter
Dim tmp As String
Sub foo()
'Init Objects
Set fso = CreateObject("Scripting.FileSystemObject")

'Get the start range
    Do
        Set start = Application.InputBox("Select some row and column [Date] to start:", Type:=8)
    Loop While start Is Nothing

    'assign variable values
    wrkcol = start.Columns(1).Column
    lr = Cells(Rows.Count, wrkcol).End(xlUp).Row

    For r = start.Rows(1).Row To lr
        tmp = ""
        Set cell = Cells(r, wrkcol)
        'build a string to write
        tmp = tmp & Cells(r, wrkcol).Offset(0, 0).Value & dlmtr    'date
        tmp = tmp & Cells(r, wrkcol).Offset(0, 1).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 2).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 3).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 4).Value & dlmtr
        tmp = tmp & Cells(r, wrkcol).Offset(0, 5).Value

        'Determine file If Exist/Else Create
        On Error Resume Next
        Set f = fso.GetFile(Cells(r, wrkcol).Offset(0, 6).Text)    'filepath
        If Err = 53 Then
            Set f = fso.CreateTextFile(Cells(r, wrkcol).Offset(0, 6).Text, False, False)     'filepath
            Set f = fso.GetFile(Cells(r, wrkcol).Offset(0, 6).Text)    'filepath
            Err = 0
        End If
        
        'open file, write and close
        Set ts = f.OpenAsTextStream(IOMode:=ForAppending)
        ts.WriteLine tmp
        ts.Close
    Next r

End Sub

I'm getting a compile error in this line:

Set ts = f.OpenAsTextStream(IOMode:=ForAppending)
​

It says ForAppending is not defined. I replaced ForAppending with 8 and it works like a charm!

Thanks for your help.