Macro pour convertir plusieurs feuilles en CSV

[Douane]

Bonjour !

Voilou j'ai beaucoup de fichiers excel avec de nombreuses feuilles. Je souhaiterais mettre le contenu de ces fichiers sur une base de donnée MySQL.

Pour cela, passer par le format CSV est parfait. Mon soucis est que faire enregistrer sous... pour chaque feuille sur chaque classeur c'est la galère...

J'ai trouvé quelquechose du genre :

Sub ConvertXLStoCSV()

    Dim strXLSFile As String
    Dim strCSVFile As String
    
    'Change Input and Output folders to relevant location
    Const strInputFolder As String = "C:\Temp\XLS\"
    Const strOutputFolder As String = "C:\Temp\CSV\"
    
    strXLSFile = Dir(strInputFolder & "*.xls")
    
    Do While strXLSFile <> ""
        strCSVFile = Left(strXLSFile, InStrRev(strXLSFile, ".")) & "csv"
        Workbooks.Open strInputFolder & strXLSFile
        ActiveWorkbook.SaveAs strOutputFolder & strCSVFile, xlCSV
        ActiveWorkbook.Close False
        strXLSFile = Dir
    Loop

Pratique dans le sens qu'il traite tous les fichiers compris dans le dossier. Mais comment faire pour qu'il traite en plus chacune des feuilles ?

Merci beaucoup et excellent après-midi !

Fabs

[mromain]

bonjour douane,

j'ai pas eu le tps de vérifier, je repars au taf.
en espérant que ça t'aidera :

Sub ConvertXLStoCSV()
    Dim curSheet As Worksheet, csvLine As String, csvSeparator As String, myFso, csvFile, i As Integer, j As Integer
    Dim strXLSFile As String
    Dim strCSVFile As String
    csvSeparator = ";"
    
    'Change Input and Output folders to relevant location
    Const strInputFolder As String = "C:\Temp\XLS\"
    Const strOutputFolder As String = "C:\Temp\CSV\"
    Set myFso = CreateObject("Scripting.FileSystemObject")

    strXLSFile = Dir(strInputFolder & "*.xls")
    
    Do While strXLSFile <> ""
        
        Workbooks.Open strInputFolder & strXLSFile
        For Each curSheet In ActiveWorkbook.Sheets
            With curSheet
                strCSVFile = Left((strXLSFile & "_" & .Name), InStrRev(strXLSFile, ".")) & "csv"
                Set csvFile = myFso.CreateTextFile(Filename:=strCSVFile, overwrite:=True)
                For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    'initialiser la ligne CSV
                    csvLine = vbNullString
                    'boucler sur les 4 colonnes
                    For j = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
                        'créer la ligne
                        csvLine = csvLine & IIf(csvLine = vbNullString, vbNullString, csvSeparator) & .Cells(i, j).Text
                    Next j
                    'écrire la ligne dans le fichier
                    csvFile.WriteLine csvLine
                Next i
                csvFile.Close
            End With
        Next curSheet
        ActiveWorkbook.Close False
        strXLSFile = Dir
    Loop
End Sub

a+

[Douane]

Salut,
Merci beaucoup pour ta réponse super rapide ! Par contre je ne sais pas si ça fonctionne, je me mange un grand "dépassement de capacité" entre les dents comme erreur de la macro...

Trouver un vrai ordinateur est peut-être nécessaire hm...


Edit :

Je sèche sur cette histoire, faudrait-il changer le type des variables ?

[Douane]

Rebonjour,
Je n'arrive pas à me débarasser de ce dépacement de capacité... Quelqu'un aurait-il une idée ?

Merci !

[mromain]

Bonjour Douane

j'ai fait une petite modif, ce code marche chez moi :

Sub ConvertXLStoCSV()
On Error GoTo erreur
Application.ScreenUpdating = False
Dim curSheet As Worksheet, csvLine As String, csvSeparator As String, myFso, csvFile, i As Integer, j As Integer
Dim strXLSFile As String, strInputFolder As String, strOutputFolder As String
Dim strCSVFile As String
csvSeparator = ";"

'Change Input and Output folders to relevant location
strInputFolder = ThisWorkbook.Path & "\"
 strOutputFolder = ThisWorkbook.Path & "\"
Set myFso = CreateObject("Scripting.FileSystemObject")

strXLSFile = Dir(strInputFolder & "*.xls")

Do While strXLSFile <> ""
    If Not strInputFolder & strXLSFile = ThisWorkbook.Path & "\" & ThisWorkbook.Name Then
        Workbooks.Open strInputFolder & strXLSFile
        For Each curSheet In ActiveWorkbook.Sheets
            With curSheet
                strCSVFile = Left((strXLSFile), InStrRev(strXLSFile, ".") - 1) & "_" & .Name & ".csv"
                Set csvFile = myFso.CreateTextFile(Filename:=strCSVFile, overwrite:=True)
                For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
                    'initialiser la ligne CSV
                    csvLine = vbNullString
                    'boucler sur les 4 colonnes
                    For j = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
                        'créer la ligne
                        csvLine = csvLine & IIf(csvLine = vbNullString, vbNullString, csvSeparator) & .Cells(i, j).Text
                    Next j
                    'écrire la ligne dans le fichier
                    csvFile.WriteLine csvLine
                Next i
                csvFile.Close
            End With
        Next curSheet
        ActiveWorkbook.Close False
    End If
    strXLSFile = Dir
Loop
erreur:
Application.ScreenUpdating = True
End Sub

il crée un fichier pour chaque feuille de chaque classeur
nomClasseur_nomFeuille.csv

a+

[Douane]

Joint Technologies ltd Blog Archive Batch convert XLS to CSV

J'ai trouvé ceci qui marche niquel.

Merci encore pour le coup de main !

[saad0n]

excuse moi je suis débutant en excel et VBA
où est ce que je récupère les fichiers CVS

[Newbe]

Bonjour à tous,
J'ai testé la macro proposé dans le lien de Douane et j'ai une erreur à la ligne:
logWks.Cells(oRow, "b").Value = .Name

me disant que la méthode Name de l'objet Worksheet a échoué

Quelqu'un sait réparer ça?