Fichiers XML transformés en xlsx ?

Bonjour à tous,

J'ai un dossier contenant plusieurs fichier XML.

Je voudrais transformer ces fichiers en fichiers xlsx par une petite routine VBA EXcel.

Je sais le faire pour un et uniquement un à la fois, comment faire une boucle qui excecute la transformation de tous les fichiers independaments en un seul clic ?

MERCI pour votre aide.

voici le coeur de la transformée :

Workbooks.OpenXML Filename:= _

CheminFichierSource, LoadOption:= _
xlXmlLoadImportToList
ChDir "le chemin du fichier source .xlm"
ActiveWorkbook.SaveAs Filename:="le chemin du fichier resultat.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close

Mon probleme est que je ne sais pas le faire sur tous les fichier du dossier source afin de les transformer dans un dossier Resultat aec le meme nom de fichier mais en xlsx.

MERCI pour votre aide.

Hello,

A adapter et à essayer, n'ayant pas de fichier .xml sous la main, je n'ai fait aucun test.

Sub ConvertXML()
Dim objFso As Object
Dim sPathInit$, sPathDest$

Set objFso = CreateObject("Scripting.FileSystemObject")
sPathInit = "Ton chemin initiale (fichier XML)"
sPathDest = "Ton chemin de destination"

For Each f In objFso.GetFolder(sPath).Files
    If LCase(Right(f.Name, 4)) = ".xml" Then
        If Len(Dir(sPathDest)) = 0 Then
            Workbooks.OpenXML Filename:= _
            sPathInit, LoadOption:= _
            xlXmlLoadImportToList
            ChDir sPathInit
            ActiveWorkbook.SaveAs Filename:=sPathDest & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close
        Else
            MsgBox "Le fichier XML a déjà été converti", vbOKOnly + vbInformation
        End If
    Else
        MsgBox "Aucun fichier XML n'a été trouvé dans ce répertoir", vbOKOnly + vbInformation
        Exit Sub
    End If
Next

MsgBox "Tous les fichiers XML de ce répertoir ont été convertis", vbOKOnly + vbInformation

Set objFso = Nothing

End Sub

Merci, A+
Kilian

Salut....

MERCI Kilian 1906 MERCI de ta reponse rapide et bien devellopée grace aux differents tests que tu realise afin de ne pas bloquer la routine.

J'ai un dossier source qui contient plus de 2000 fichiers .xml de meme structure. Dans un premier temps je voudrais transformer ces fichiers, en respectivement un fichier équivalent de meme nom mais sous un format .xlsx dans un dossier cible.

J'ai adapté ta solution mais je bute sur la ligne "For Each f In objFso.GetFolder(sPathInit).Files" qui m'indique erreur '76' chemin d'accès introuvable.

Apres une heure de recherche, je me retourne vers toi.... je seche

Pourtant j'ai bien verifié mes chemins d'accès.

voici deux fichiers .xml en exemple :

MERCI pour ton soutient et support.

A+

Joe

Salut Kilian...

J'ai enfin trouvé l'erreur du chemin...... un espace de trops dans le path demandé...

Je ne comprend pas l'erreur suivante : erreur 1004 Désolé nous ne trouvons pas c:\users\Joe\Desktop\XML-origine\ sur les lignes en surlignées jaune

Workbooks.OpenXML Filename:= _

sPathInit, LoadOption:= _

xlXmlLoadImportToList

voici code ajusté :

Sub ConvertXML()

Application.ScreenUpdating = False

Dim objFso As Object

Dim sPathInit$, sPathDest$

Set objFso = CreateObject("Scripting.FileSystemObject")

sPathInit = "C:\Users\Joe\Desktop\XML-origine\"

sPathDest = "C:\Users\Joe\Desktop\XLSX-fin\"

For Each f In objFso.GetFolder(sPathInit).Files 'Pour tous les fichiers du dossier XML-origine

If LCase(Right(f.Name, 4)) = ".xml" Then 'Si le fichier est un .xml ?

If Len(Dir(sPathDest)) = 0 Then ' ??????

Workbooks.OpenXML Filename:= _

sPathInit, LoadOption:= _

xlXmlLoadImportToList

ChDir sPathInit

ActiveWorkbook.SaveAs Filename:=sPathDest & ".xlsx", _

FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

ActiveWorkbook.Close

Else

MsgBox "Le fichier XML a déjà été converti", vbOKOnly + vbInformation

End If

Else

MsgBox "Aucun fichier XML n'a été trouvé dans ce Dossier", vbOKOnly + vbInformation

Exit Sub

End If

Next

MsgBox "Tous les fichiers XML de ce Dossier ont été convertis", vbOKOnly + vbInformation

Set objFso = Nothing

Application.ScreenUpdating = True

End Sub

Peut tu me dire l'interet de cette condition ? : If Len(Dir(sPathDest)) = 0 Then et l'explication de la syntaxe MERCI

MERCI a toi de ta patience et de tes retours.

A+ Joe

Bonjour,

Tout d'abord, pense à mettre ton code entre balise

Ensuite, sans avoir testé, mais il me semble que le filename serait plutôt "f", non?

Peut-être?

Salut Cousinhub

je viens d'essayer le "f" meme erreur générée.

MERCI du conseil, je mettrais le code comme il se doit sur le forum

A+

Hello,

De cousinhub :

Ensuite, sans avoir testé, mais il me semble que le filename serait plutôt "f", non?

Bien vue, erreur de ma part de ne pas spécifier le nom du classeur.

De Joe le Débutant :

Peut tu me dire l'interet de cette condition ? : If Len(Dir(sPathDest)) = 0 Then et l'explication de la syntaxe MERCI

L''instruction
If Len(Dir(sPathDest & f.Name)) = 0 Then

Contrôle si le fichier existe déjà dans le répertoire de destination. (Len contrôle le nombre de caractère, Dir dans le répertoire)
Si tel est le cas, renvoi MsgBox "Le fichier XML a déjà été converti", vbOKOnly + vbInformation
puis continu la boucle.

J'ai donc fait un test avec ton XML et fonctionne chez moi.

J'ai également mis en commentaire ton ChDir car il n'a pas d'intérêt ici comme tu défini les dossiers dans les variables sPathInit, sPathDest.

Voici le code corrigé

Sub ConvertXML()
Dim objFso As Object
Dim sPathInit$, sPathDest$

Set objFso = CreateObject("Scripting.FileSystemObject")
sPathInit = "C:\Users\kilian\Documents\XML\"
sPathDest = "C:\Users\kilian\Documents\XSLX\"

For Each f In objFso.GetFolder(sPathInit).Files
    If LCase(Right(f.Name, 4)) = ".xml" Then
        If Len(Dir(sPathDest & f.Name)) = 0 Then
            Workbooks.OpenXML Filename:=sPathInit & f.Name, LoadOption:=xlXmlLoadImportToList
            'ChDir sPathInit
            ActiveWorkbook.SaveAs Filename:=sPathDest & Replace(f.Name, ".xml", "") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close
        Else
            MsgBox "Le fichier XML a déjà été converti", vbOKOnly + vbInformation
        End If
    Else
        MsgBox "Aucun fichier XML n'a été trouvé dans ce répertoir", vbOKOnly + vbInformation
        Exit Sub
    End If
Next

MsgBox "Tous les fichiers XML de ce répertoir ont été convertis", vbOKOnly + vbInformation

Set objFso = Nothing

End Sub

A+,
Kilian

Salut

MERCI Kilian de ta solution, effectivement je n'aurais pas pu trouver sans avoir à décortiquer la syntaxe de la ligne :workbooks.OpenXML Filename...........

Encore merci de ton support, mon projet va avancer...

J'ai retirer le test : If Len(Dir(sPathDest & f.Name)) = 0 Then....... car tout mes fichiers origines (les XML) ont la meme struture de nomage, ce qui fait que la routine me converti uniquement le premier fichier. Genant lorsque j'en ai un peu plus de 2000 ....

Grace à toi, je vais passer à la suite.

A+ Bonnes fêtes de fin d'année.