XL 2019 "Batch Convert" un groupe de fichier XLS en XLSX

M7cks

XLDnaute Nouveau
Bonjour à tous,

Voilà, chaque mois je reçois une vingtaine de fichiers exportés par un logiciel qui ne peut qu'exporter les fichiers en XLS et j'en ai besoin en XLSX.
Le nombre de fichiers grandissant une automatisation de la tâche s'impose.

Après beaucoup de recherches j'ai trouvé une fonction écrite par un très bon développeur en la matière, la fonction marche super bien pour un fichier, après un court échange avec le développeur en question il m'a partagé un bout de code pour "loop" la fonction afin de convertir tout un dossier.

Le problème c'est que pour lui tout fonctionne très bien alors que de mon coté j'ai que le premier fichier de convertie et après ça me fait une erreur "424 Object Required".

J'essaye de comprendre comment résoudre ça mais là, je bloque, est-ce que quelqu'un aurait une idée ?

Voici la fonction :

VB:
'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
' Procedure : XLS_ConvertXLS2XLSX
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Converts an xls (2003-) into an xlsx (2007+)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sXLSFile  : String - XLS file path, name and extension to be converted
' bDelXLS   : True/False - Should the original XLS file be deleted after the conversion
'
' Usage:
' ~~~~~~
' Call XLS_ConvertXLS2XLSX("C:TempTest.xls")
' Call XLS_ConvertXLS2XLSX("C:TempTest.xls", False)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-02-27              Initial Release
'---------------------------------------------------------------------------------------
Function XLS_ConvertXLS2XLSX(ByVal sXLSFile As String, Optional bDelXLS As Boolean = True)
          '#Const EarlyBind = True 'Use Early Binding, Req. Reference Library
    #Const EarlyBind = False    'Use Late Binding
    #If EarlyBind = True Then
              'Early Binding Declarations
              Dim oExcel            As Excel.Application
              Dim oExcelWrkBk       As Excel.WorkBook
    #Else
              'Late Binding Declaration/Constants
              Dim oExcel            As Object
              Dim oExcelWrkBk       As Object
              Const xlOpenXMLWorkbook = 51
    #End If
          Dim bExcelOpened          As Boolean

          'Start Excel
10        On Error Resume Next
20        Set oExcel = GetObject(, "Excel.Application")      'Bind to existing instance of Excel
30        If Err.Number <> 0 Then      'Could not get instance of Excel, so create a new one
40            Err.Clear
50            On Error GoTo Error_Handler
60            Set oExcel = CreateObject("Excel.Application")
70            bExcelOpened = False
80        Else      'Excel was already running
90            bExcelOpened = True
100       End If
110       On Error GoTo Error_Handler

120       oExcel.ScreenUpdating = False
130       oExcel.Visible = False     'Keep Excel hidden until we are done with our manipulation
140       Set oExcelWrkBk = oExcel.Workbooks.Open(sXLSFile)
150       oExcelWrkBk.SaveAS Replace(sXLSFile, ".xls", ".xlsx"), xlOpenXMLWorkbook, , , , False
160       oExcelWrkBk.Close False
170       If bExcelOpened = True Then oExcel.Quit

180       If bDelXLS = True Then Kill (sXLSFile)

Error_Handler_Exit:
190       On Error Resume Next
200       Set oExcelWrkBk = Nothing
210       Set oExcel = Nothing
220       Exit Function

Error_Handler:
230       MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: XLS_ConvertXLS2XLSX" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occured!"
240       oExcel.ScreenUpdating = True
250       oExcel.Visible = True     'Make excel visible to the user
260       Resume Error_Handler_Exit
End Function

Voici la boucle :
Code:
Dim sFile                 As String
    Dim sPath                 As String

    sPath = "C:Temp"    'Folder to iterate over the xls files and convert to xlsx
    If Right(sPath, 1) <> "" Then sPath = sPath & ""
    sFile = Dir(sPath & "*.xls")
    Do While sFile <> vbNullString
        If sFile <> "." And sFile <> ".." Then
            '            sFile 'FileName, does not include the path
            Call XLS_ConvertXLS2XLSX(sPath & sFile, False) 'False, to perform the conversion but retain the original xls files
        End If
        sFile = Dir     'Loop through the next file that was found
    Loop
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil

C'est mieux de tout mettre, non ?
VB:
'---------------------------------------------------------------------------------------
' Procedure : XLS_ConvertXLS2XLSX
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Converts an xls (2003-) into an xlsx (2007+)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
 

Staple1600

XLDnaute Barbatruc
Re

Il s'agissait juste de respecter la licence...
détails

Sinon pour ta question, voir ci-dessous ce qui me turlupine ;)
VB:
Sub test()
sPath = "C:Temp"    'Folder to iterate over the xls files and convert to xlsx
If Right(sPath, 1) <> "" Then sPath = sPath & ""
MsgBox sPath
'j'écrirai plutôt ceci, non ?
sPath = "C:\Temp"    'Folder to iterate over the xls files and convert to xlsx
If Right(sPath, 1) <> "" Then sPath = sPath & "\"
MsgBox sPath
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Je suppose que le michael de la-bàs est le M7cks d'ici ;)
Michael | August 21, 2019 at 9:38 am
Thanks for your answer,
424 Error – Object Required
Only the first file is converted.
Seems like this line cause the problem :
140 Set oExcelWrkBk = oExcel.Workbooks.Open(sXLSFile)
Et l'auteur confirme que sa bouche a fonctionné sur 20 classeurs et il conclut

There must be something else in your code causing an issue.
Reste plus qu'à trouver le something else ;)
 

M7cks

XLDnaute Nouveau
Et oui ce fut mon "court échange" avec l'auteur ^^

J'ai mis ça pour le chemin d'acces, c'est d’ailleurs la seule chose que j'ai changé :rolleyes:
VB:
sPath = "C:\XLS_to_XLSX\"    'Folder to iterate over the xls files and convert to xlsx
If Right(sPath, 1) <> "" Then sPath = sPath & ""

Du coup je vois pas trop qu'est-ce que pourrait être ce something else.
 

Staple1600

XLDnaute Barbatruc
Re

Au cas où, tu ne saurais pas faire ce que je te suggérais à propos de mon vieux bout de code (voir message#6)
Je l'ai fait et donc si cela peut servir, je le poste ici
VB:
Sub Test_OK_III()
Dim FolderName$, MyPath, wkbSource As Workbook
'Selection du dossier contenant les *.xls à traiter
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    FolderName = .SelectedItems(1)
    Err.Clear
    On Error GoTo 0
End With
MyPath = FolderName
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Boucle sur l'ensemble des fichiers du répertoire
MyFile = Dir(MyPath & "*.xls")
Application.DisplayAlerts = False
Do While Len(MyFile) > 0
  Set wkbSource = Workbooks.Open(MyPath & MyFile)
  'Avec le classeur ouvert ou qu'on vient d'ouvrir...
  With wkbSource
 On Error Resume Next
       'conversion en fichier XLSX
       .SaveAs MyPath & VBA.Left(.Name, InStr(.Name, ".") - 1), FileFormat:=xlOpenXMLWorkbook
       .Close savechanges:=False
  End With
  Set wkbSource = Nothing
  'Et on passe au suivant
  MyFile = Dir()
Loop
End Sub
Test OK dans un dossier contenant 3 *.xls
Je te laisse tester avec beaucoup plus ;)
 

M7cks

XLDnaute Nouveau
Ah ! tu es trop rapide pour moi !
J'ai modifier ton code qui est bien plus simple.
Voici ce que j'ai fait, c'est exactement la même chose que tu a posté ^^ :

VB:
Sub Convert_XLS_To_XLSX()
Dim FolderName$, MyPath, wkbSource As Workbook

'Only if you want to set MyPath with msoFileDialogFolderPicker
'With Application.FileDialog(msoFileDialogFolderPicker)
'    .AllowMultiSelect = False
'    .Show
'    On Error Resume Next
'    FolderName = .SelectedItems(1)
'    Err.Clear
'    On Error GoTo 0
'End With

MyPath = "C:\PATH"

If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Boucle sur l'ensemble des fichiers du répertoire
MyFile = Dir(MyPath & "*.xls")
Application.DisplayAlerts = False

Do While Len(MyFile) > 0
  Set wkbSource = Workbooks.Open(MyPath & MyFile)
  'Avec le classeur ouvert ou qu'on vient d'ouvrir...
  With wkbSource
 On Error Resume Next
  '     conversion en fichier XLSX
       .SaveAs MyPath & VBA.Left(.Name, InStr(.Name, ".") - 1), FileFormat:=xlOpenXMLWorkbook, Local:=True
       .Close savechanges:=False
  End With
  Set wkbSource = Nothing
  'Et on passe au suivant
  MyFile = Dir()
Loop

End Sub

J'ai une question concernant le code de Daniel Pineault, j'ai du mal a comprendre cette partie :
VB:
#If EarlyBind = True Then
              'Early Binding Declarations
              Dim oExcel            As Excel.Application
              Dim oExcelWrkBk       As Excel.WorkBook
    #Else
              'Late Binding Declaration/Constants
              Dim oExcel            As Object
              Dim oExcelWrkBk       As Object
              Const xlOpenXMLWorkbook = 51
    #End If

Puis ensuite il masque excel via ceci :
VB:
oExcel.ScreenUpdating = False
oExcel.Visible = False

Est-ce que cela marche vraiment ? Le code s’exécute sans qu'on puisse voir excel bouger ?


Merci pour ton aide, ça marche à merveille !
 

Staple1600

XLDnaute Barbatruc
Re

Pour ma curiosité, ton dossier contenait combien de *.xls?

Pour ceci
#If EarlyBind = True Then 'Early Binding Declarations Dim oExcel As Excel.Application Dim oExcelWrkBk As Excel.WorkBook #Else 'Late Binding Declaration/Constants Dim oExcel As Object Dim oExcelWrkBk As Object Const xlOpenXMLWorkbook = 51 #End If
On teste si la référence Microsoft Scripting Runtime est cochée dans les références de VBA
Si oui on déclare en Early Binding
Si non, on déclare As Object (Late Binding)
 
C

Compte Supprimé 979

Guest
Bonjour le fil

Pour commencer, le test sur le path est en général celui-ci
VB:
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

Ensuite, je vois un gros inconvénient au code, le ".XLS" peut contenir du code VBA et donc l'enregistrer en ".XLSX" supprime le code :eek:

Voici un fichier avec un code simple qui fonctionne ;)

Edit : oups, j'arrive peut-être un peu tard, sauf pour le ".xlsm"
 

Pièces jointes

  • Convert XLS2XLSXorM.xlsm
    21.5 KB · Affichages: 12

Staple1600

XLDnaute Barbatruc
Bonjour BrunoM45

Edit : oups, j'arrive peut-être un peu tard, sauf pour le ".xlsm"
Comme les fichiers à traiter viennent d'un logiciel tiers (voir message#1), normalement ils ne contiennent pas de macros, donc j'ai zappé cette éventualité (tout en étant conscient du risque ;))

Maintenant le demandeur a le choix:
macroter avec une goutte de sueur qui perlera sur son front (avec une musique angoissante en fond sonore)
ou
macroter en restant tout sec ;)
 

Discussions similaires