VBA多个FreeFile导出为CSV

时间:2017-02-16 14:05:39

标签: excel vba excel-vba csv text

我正在尝试使用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,具体取决于来源的未知列数.... ?????

1 个答案:

答案 0 :(得分:1)

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

但是在你的代码中,你为每一行调用它。

你的错误处理不合适,所以我添加了一个sub来展示你应该如何使用! ;)

    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