VBA多个FreeFile导出为CSV

Question

我正在尝试使用Freefile导出到文本文件。 该过程将获取一个包含许多列的工作表，并针对每一列将其导出为文本。

我一直遇到的问题是出现错误55代码“文件已打开”。

因为我希望列范围作为输入具有可变长度，所以我不确定我需要多少个freefile命令。

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

我如何避免这些错误将根据需要导出多少新的CSV，具体取决于源中未知的列数。

Answer 1

每次调用FreeFile都会生成一个新的文件号。

但是在您的代码中，您需要为每一行调用它。

而且错误处理不合适，因此我添加了一个子代码来显示您应该如何使用！ ;）

    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