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

[M7cks]

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 :

'---------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------
' 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 :

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

 

[Staple1600]

Bonjour le fil

C'est mieux de tout mettre, non ?

'---------------------------------------------------------------------------------------
' 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

 

[M7cks]

Et oui j'ai voulu éviter de faire de la pub connaissant pas la politique du forum 🙄

Edit : C'est rajouté ^^

 

[Staple1600]

Re

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

Sinon pour ta question, voir ci-dessous ce qui me turlupine 😉

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]

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 😉

 

[Staple1600]

Re

Sinon jadis dans un fil, j'avais commis ce code

https://www.excel-downloads.com/thr...toire-via-macro.20031622/page-2#post-20234019

Tu vois comment l'adapter pour un SaveAs en *.xlsx?

 

[M7cks]

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é 🙄

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]

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

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]

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é ^^ :

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 :

#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 :

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]

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)

 

[M7cks]

Re,

D'accord, merci pour ces précisions;

Je viens de test sur 25 fichiers (taille moyenne de 150 ko), ça n'a pris que quelques secondes.

 

[Compte Supprimé 979]

Bonjour le fil

Pour commencer, le test sur le path est en général celui-ci

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 😱

Voici un fichier avec un code simple qui fonctionne 😉

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

 

[Staple1600]

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 😉

 

[M7cks]

Bonsoir Bruno45,

Effectivement les fichiers viennent d'un logiciel tiers donc pas de macro, je garde ton fichiers sous le coude au cas où un jour la situation ce présente mais pour l'instant je vais rester sec ^^.

Merci pour votre aide 🙂