VBA Exportations FreeFile multiples au format CSV

Question

J'essaie d'utiliser le fichier Freefile pour exporter vers des fichiers texte. Le processus prend une feuille de calcul avec plusieurs colonnes et pour chaque colonne, l'exporte en tant que texte.

Le problème que j'ai eu est d'obtenir le code erreur 55 "le fichier est déjà ouvert". Parce que je veux que la plage de colonnes soit d'une longueur variable, je ne sais pas avec certitude combien de commandes de fichiers libres j'aurais besoin.

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 

Comment puis-je éviter ces erreurs exporter autant de nouvelles que je CSV de besoin en fonction du nombre inconnu de colonnes de la source .... ?????

Answer 1

FreeFile va générer un nouveau numéro de fichier chaque fois que vous l'appelez.

Mais dans votre code, vous l'appeliez pour chaque ligne.

Et vous la gestion des erreurs n'était pas approprié, j'ai donc ajouté un sous pour montrer comment vous devriez utiliser!

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