Convertir tous les .xls des sous-dossiers d'un dossier

[Disten]

Bonjour, voici mon script pour convertir les .xls soit en .xlsm soit en .xlsx dépendant si il trouve une macro ou non


Sub Copy_XLS_as_XLSX()

Convert_XLS_to_XLSX False

End Sub

Sub Delete_XLS_after_Copy_XLS_as_XLSX()

Convert_XLS_to_XLSX True

End Sub

Sub Convert_XLS_to_XLSX(ByVal deleteXLS As Boolean)

' Allow user to choose a folder, where all .xls files in that folder will be converted to
' .xlsx or .xlsm format, depending on whether they have macros or not...



Dim xDirect$, xFname$, InitialFoldr$
Dim wbk As New Workbook
Dim msg As Integer



InitialFoldr$ = "C:\Users\support\Desktop\Test-Excel" 'Startup folder to begin searching from

If deleteXLS = True Then 'as user if they really want to delete .xls files

msg = MsgBox("Do you want to delete all .xls files after you have created a copy in .xlsx format? If you are not sure, click NO!", vbYesNo, "Ready to delete .xls files?")

End If

If msg = vbNo Then 'user doesn't want to delete files...

deleteXLS = False

End If



With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder containing the .xls files you want to convert..."
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)

Do While xFname$ <> "" 'loop through all filenames in folder

If Right(xFname$, 4) = ".xls" Then 'only convert .xls files

Application.DisplayAlerts = False 'turn off any unwanted messages

Set wbk = Workbooks.Open(Filename:=xDirect$ & xFname$)

If wbk.HasVBProject Then ' convert Excel files containing Macros
wbk.SaveAs Filename:=xDirect$ & xFname$ & "m", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled

Else ' convert standard Excel files
wbk.SaveAs Filename:=xDirect$ & xFname$ & "x", _
FileFormat:=xlOpenXMLWorkbook
End If

wbk.Close SaveChanges:=False

If deleteXLS = True Then 'delete existing xls files if desired

With New FileSystemObject 'include Excel reference to Microsoft Scripting.Runtime library... or this won't work... Go to Tools>References in the VBA editing window

If .FileExists(xDirect$ & xFname$) Then
.DeleteFile xDirect$ & xFname$
End If

End With

End If

Application.DisplayAlerts = True 'turn messages back on

End If

xFname$ = Dir ' get next filename in folder

Loop

End If

End With

xRow = MsgBox("All .xls files have now been converted.", , "Finished!")



End Sub




J'aimerais pouvoir l'appliquer pour tous les sous-dossiers de mon répertoire ciblé à la base, avez-vous une idée ?

 

[Disten]

Sub Copy_XLS_as_XLSX()

    Convert_XLS_to_XLSX False
 
End Sub

Sub Delete_XLS_after_Copy_XLS_as_XLSX()

    Convert_XLS_to_XLSX True
 
End Sub

Sub Convert_XLS_to_XLSX(ByVal deleteXLS As Boolean)
 
    ' Allow user to choose a folder,  where all .xls files in that folder will be converted to
    ' .xlsx or .xlsm format, depending on whether they have macros or not...
 
      
 
    Dim xDirect$, xFname$, InitialFoldr$
    Dim wbk As New Workbook
    Dim msg As Integer
 
 
 
    InitialFoldr$ = "C:\Users\support\Desktop\Test-Excel"    'Startup folder to begin searching from
 
    If deleteXLS = True Then  'as user if they really want to delete .xls files
                  
        msg = MsgBox("Do you want to delete all .xls files after you have created a copy in .xlsx format? If you are not sure, click NO!", vbYesNo, "Ready to delete .xls files?")
 
    End If
 
    If msg = vbNo Then  'user doesn't want to delete files...
 
        deleteXLS = False
      
    End If
    
    
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder containing the .xls files you want to convert..."
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
          
            Do While xFname$ <> ""  'loop through all filenames in folder
          
                If Right(xFname$, 4) = ".xls" Then  'only convert .xls files
              
                    Application.DisplayAlerts = False  'turn off any unwanted messages
                  
                    Set wbk = Workbooks.Open(Filename:=xDirect$ & xFname$)
          
                    If wbk.HasVBProject Then  ' convert Excel files containing Macros
                      wbk.SaveAs Filename:=xDirect$ & xFname$ & "m", _
                        FileFormat:=xlOpenXMLWorkbookMacroEnabled
                      
                    Else  ' convert standard Excel files
                       wbk.SaveAs Filename:=xDirect$ & xFname$ & "x", _
                        FileFormat:=xlOpenXMLWorkbook
                    End If
                  
                    wbk.Close SaveChanges:=False
                  
                    If deleteXLS = True Then  'delete existing xls files if desired
                  
                        With New FileSystemObject 'include Excel reference to Microsoft Scripting.Runtime library... or this won't work...  Go to Tools>References in the VBA editing window
                      
                            If .FileExists(xDirect$ & xFname$) Then
                                .DeleteFile xDirect$ & xFname$
                            End If
                          
                        End With
                      
                    End If
                  
                    Application.DisplayAlerts = True  'turn messages back on
                  
                End If
              
                xFname$ = Dir  ' get next filename in folder
              
            Loop
          
        End If
      
    End With
 
    xRow = MsgBox("All .xls files have now been converted.", , "Finished!")
 
 

End Sub

Pardon, ca sera plus lisible