VBA Multiple FreeFile Exports to CSV

Question

I'm trying to use the Freefile to export to text files. The process is taking a worksheet with many columns and for each column, exporting it as text.

The problem I've been having is getting the error 55 code "file is already open".

Because I want the column range as the input to be of a variable length, I don't know for certain how many freefile commands I would need.

For j = intColumOffsett + 1 To intLastColumn

strDate = wkSource.Cells(1, j).Value

strNewFile = strDirectory & strDate & " New.csv"


For i = 1 To intLastRow
    strTarget = strTarget & wkSource.Cells(i, 1).Value & ","
    strTarget = strTarget & wkSource.Cells(i, 2).Value & ","
    strTarget = strTarget & wkSource.Cells(i, 3).Value & ","
    strTarget = strTarget & strDate & ","
    strTarget = strTarget & wkSource.Cells(i, j).Value

' It's this this section I'm not sure about \/ 
'Set strNewFile = Nothing
'Stop
iF1 = FreeFile(j)
'Close #iF1

On Error GoTo Error:
    Open strNewFile For Output As #iF1
         Print #iF1, strTarget
        Debug.Print strTarget
    strTarget = ""
Error:
    MsgBox (Err.Description)

Next i
Close #iF1
Next j

How can I avoid these errors will exporting as many new CSV's as I needed depending on the unknown number of columns from the source....?????

Answer 1

FreeFile will generate a new file number each time you call it.

But in your code, you were calling it for each row.

And you error handling wasn't appropriate, so I added a sub to show how you should use! ;)

    Sub MultiFreeFiles()
    '''...

    For j = intColumOffsett + 1 To intLastColumn
        strDate = wkSource.Cells(1, j).Value
        strNewFile = strDirectory & strDate & " New.csv"

        iF1 = FreeFile

        On Error GoTo Error:
        Open strNewFile For Output As #iF1

        For i = 1 To intLastRow
            strTarget = vbNullString
            With wkSource
                strTarget = strTarget & .Cells(i, 1).Value & ","
                strTarget = strTarget & .Cells(i, 2).Value & ","
                strTarget = strTarget & .Cells(i, 3).Value & ","
                strTarget = strTarget & strDate & ","
                strTarget = strTarget & .Cells(i, j).Value
            End With 'wkSource

            Debug.Print strTarget

            Print #iF1, strTarget
        Next i
        Close #iF1
    Next j
    '''...


    Exit Sub
Error:
    MsgBox (Err.Description)
    Resume

    End Sub