VBA複数のFreeFile CSVへのエクスポート

Question

私はFreefileを使ってテキストファイルに書き出しようとしています。このプロセスでは、多数の列と各列のワークシートをテキストとしてエクスポートしています。

私が抱えていた問題は、エラー55コード "ファイルは既に開いています"が表示されていることです。

可変長の入力として列範囲を使用したいので、必要なフリーファイルコマンドの数がわかりません。

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