VBA Mehrere FreeFile exportiert in CSV

Question

Ich versuche, das Freefile zu exportieren, um Textdateien zu exportieren. Der Prozess nimmt ein Arbeitsblatt mit vielen Spalten und für jede Spalte und exportiert es als Text.

Das Problem, das ich habe, ist der Fehler 55 Code "Datei ist bereits geöffnet".

Da ich möchte, dass der Spaltenbereich als Eingabe eine variable Länge hat, weiß ich nicht genau, wie viele Freefile-Befehle ich benötigen würde.

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 

Wie kann ich vermeiden, diese Fehler so viele neue CSV des Export als ich auf die unbekannte Anzahl der Spalten von der Quelle abhängig benötigt .... ?????

Answer 1

FreeFile erzeugt bei jedem Aufruf eine neue Dateinummer.

Aber in Ihrem Code haben Sie es für jede Zeile aufgerufen.

Und Sie Fehlerbehandlung war nicht angemessen, also habe ich ein Sub hinzugefügt, um zu zeigen, wie Sie verwenden sollten! ;)

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