Discussion :

[Identifiant75]

Bonjour,

Voici mon problème:
J'ai un dossier rempli de fichier .CSV. J'aimerais convertir tous ces fichiers en .XLSX et les envoyer vers un autre dossier.
Ma contrainte: Les .CSV ont des ";" en guise de délimitation...

Voici mon code, qui d'après moi est bon, mais ne prend pas en compte le format 4 de delimiter qui devrait etre les";".
La macro me les converti mais en prenant les "," comme delimiter....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub CSVtoXls()
 
 Dim CSVfolder As String
 Dim XlsFolder As String
 Dim fname As String
 Dim wBook As Workbook
 
 CSVfolder = "C:\Users\Desktop\TEST\"
 XlsFolder = "C:\Users\Desktop\TEST_XLSX\"
 
 fname = Dir(CSVfolder & "*.csv")
 
 Do While fname <> ""
    Set wBook = Workbooks.Open(CSVfolder & fname, Format:=4)
    wBook.SaveAs XlsFolder & Replace(fname, ".csv", ""), ThisWorkbook.FileFormat
    wBook.Close False
 fname = Dir
 Loop
 
End Sub

Ai-je oublié quelques choses ?

(Ps: dsl pour les fautes s'il y en a, c'est certainement la fatigue...)

[kiki29]

Salut, à adapter car conversion xls en xlsx et également pour le dossier destination

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
 
Dim Nb As Long
Const sExtension As String = "xls"
Const sNewExtension As String = "xlsx"
Const TypeFichier = "xls"
 
Private Sub ChangerExtensionFichiers(ByVal sDossier As String, bSousDossier As Boolean)
Dim FSO As Object
Dim Dossier As Object
Dim sFichier As String, F As String
Dim Pos As Long, i As Long, sExt As String
Dim TFichier() As String
Dim sNom As String
 
    Application.ScreenUpdating = False
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(sDossier)
 
    TFichier = Split(TypeFichier, ";")
 
    sFichier = Dir$(sDossier & "\*.*")
 
    Do While Len(sFichier) > 0
        F = FSO.GetFileName(sFichier)
        For i = LBound(TFichier) To UBound(TFichier)
            If UCase(sFichier) <> UCase(ThisWorkbook.Name) Then
                Pos = InStr(F, TFichier(i))
                sExt = FSO.GetExtensionName(F)
                If Pos > 0 And UCase(sExt) = UCase(sExtension) Then
                    sNom = Left$(F, Len(F) - Len(sExt))
 
                    Workbooks.Open Filename:=sDossier & "\" & sFichier
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=sDossier & "\" & sNom & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    ActiveWorkbook.Close
                    Application.DisplayAlerts = True
 
                    Nb = Nb + 1
                End If
            End If
        Next i
        sFichier = Dir$()
        Application.StatusBar = Nb
    Loop
 
    If bSousDossier Then
        For Each Dossier In Dossier.SubFolders
            ChangerExtensionFichiers Dossier.Path, True
        Next Dossier
    End If
 
    Application.ScreenUpdating = True
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub
 
Sub SelDossier()
Dim sStr As String
    sStr = Replace(TypeFichier, ";", "   ")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "Conversion fichiers ( " & sStr & " ) de " & UCase(sExtension) & " en " & UCase(sNewExtension)
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        Nb = 0
        If .SelectedItems.Count > 0 Then
            DoEvents
            ChangerExtensionFichiers .SelectedItems(1), True
        End If
    End With
End Sub

[Identifiant75]

Merci pour la réponse rapide. J'essaie demain et je vous tiens informé.

[kiki29]

Salut, pour adapter au csv le fichier précédent, ces modifs, placées aux endroits idoines, devraient suffire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Const sExtension As String = "csv"
Const TypeFichier = "csv"
 
Workbooks.Open Filename:=sDossier & "\" & sFichier, Local:=True

[Identifiant75]

Ca marche sur mon dossier test

Je l'applique sur les dossiers concernés et je vous tiens au courant.

Merci

[kiki29]

Salut, depuis il y a : Conversion de fichiers Excel