Discussion :

[strawhattt]

Bonjour, s'il vous plait j'ai un problème
je veux convertir des fichiers xls en xlsx d'un répertoire, j'arrive à les convertir mais j'ai les anciens fichiers xls qui sont encore présent.

je veux savoir si c'est possible d'après la conversion de supprimer les anciens fichiers.
Et Merci beaucoup pour votre aide

--------------------------------------

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 = "Changement Extension 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

[kiki29]

Salut, à lire et pratiquer : Manipulation des fichiers en VBA

P.-S. : Il est souhaitable de baliser son code