VBA Multiple 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