Conversion XML en Excel

Bonjour,

Je suis débutante en VBA, et je cherchais en vain une solution pour mon problème.

Je voudrais convertir 100 fichiers XML en 100 fichiers EXCEL.

j'ai trouve une macro qui fera l'affaire , mais le résultat n'est pas trop satisfaisant :

voici la macro

Sub xml()
'
' xml Macro
'

Dim f As String
Dim wbk As Workbook
Dim s As Integer
Dim nm As String, pathxml As String, pathxl As String

pathxml = Workbooks(ActiveWorkbook.Name).path & "\XML\"
pathxl = Workbooks(ActiveWorkbook.Name).path & "\EXCEL\"
f = Dir(pathxml & "\*.xml")
s = 0

Do While Len(f) > 0
    s = s + 1
    Set wbk = Workbooks.OpenXML(pathxml & "\" & f)
    wbk.SaveAs Filename:=pathxl & f & ".xls"
    wbk.Close False
    f = Dir()
Loop

'
End Sub

Le problème de cette macro est: elle affiche les noms des colonnes avec des / (exemple : Personne/birthday, Personne/FirstName......) , alors c'est pas ce que je cherche donc je suis tombée sur une macro qui marche super bien et donne le résultat attendu :

Sub ImporterFichierXML()

    Dim XM As XmlMap 
    'Importe le fichier dans la cellule B1 de la Feuil3.
   ThisWorkbook.XmlImport _
        URL:="C:\Nom Fichier.xml", _
        ImportMap:=Nothing, _
        Overwrite:=True, _
        Destination:=Worksheets("Feuil3").Range("$B$1") 
    'Définit le mappage qui vient d'être ajouté.
   'ThisWorkbook.XmlMaps.Count correspond au dernier xml mappé dans le classeur
   Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count) 

    MsgBox "Import terminé" & vbCrLf & _
        XM.RootElementName & vbCrLf & _
        XM.Name & vbCrLf & _
        XM.DataBinding.SourceUrl

End Sub

Le problème ce que ça marche pour un seul fichier , il me faudra une boucle pour faire la même chose pour les 100 fichiers

il y a un moyen pour faire ça , URL ne prend en paramètre qu'une seule source ?

Aidez-moi s'il vous plait

Merci par avance

Bonjour,

à tester

Sub xml()
'
' xml Macro
'

Dim f As String
Dim wbk As Workbook
Dim s As Integer
Dim nm As String, pathxml As String, pathxl As String

pathxml = Workbooks(ActiveWorkbook.Name).Path & "\XML\"
pathxl = Workbooks(ActiveWorkbook.Name).Path & "\EXCEL\"
f = Dir(pathxml & "\*.xml")
s = 0

Do While Len(f) > 0
    s = s + 1
    ThisWorkbook.XmlImport _
        URL:=pathxml & f, _
        ImportMap:=Nothing, _
        Overwrite:=True, _
        Destination:=Worksheets("Feuil1").Range("$A$1")
   Worksheets("Feuil1").SaveAs Filename:=pathxl & replace(f,".xml", ".xls")
    f = Dir()
Loop

'
End Sub

Bonjour,

Merci pour votre réponse h2so4.

J'ai l'erreur 400

re-bonjour,

à tester, si cela ne fonctionne pas merci de mettre un fichier XML en pièce jointe.

Sub xml()
'
' xml Macro
'

    Dim f As String
    Dim wbk As Workbook
    Dim s As Integer
    Dim nm As String, pathxml As String, pathxl As String

    pathxml = Workbooks(ActiveWorkbook.Name).Path & "\XML\"
    pathxl = Workbooks(ActiveWorkbook.Name).Path & "\EXCEL\"
    f = Dir(pathxml & "*.xml")
    s = 0

    Do While Len(f) > 0
        s = s + 1
        ThisWorkbook.XmlImport _
                URL:=pathxml & f, _
                ImportMap:=Nothing, _
                Overwrite:=True, _
                Destination:=Worksheets("Feuil1").Range("$A$1")
        Worksheets("Feuil1").SaveAs Filename:=pathxl & Replace(f, ".xml", ".xls")
        f = Dir()
    Loop

    '
End Sub

Bonjour.

Sinon avant la première réponse d'h2so4 j'avais commencé à faire ça, j'avais posté (à une minute près !), mais puisqu'il semble y avoir un soucis, je partage. Au pire ignorez juste ce message

Sub Save()
' Activer outils/références Microsoft Scripting Runtime
Dim strFolderName As String
strFolderName = "P:\Documents\test"
Static FSO As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim nom As String
Dim taille As Integer
Dim nb As Integer
nb = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oSourceFolder = FSO.GetFolder(strFolderName)
  For Each oFile In oSourceFolder.Files
    Workbooks.Open Filename:=strFolderName & "\" & oFile.Name
    Workbooks(oFile.Name).Activate
    taille = Len(oFile.Name)
    nom = Left(oFile.Name, taille - 4)
    ActiveWorkbook.SaveAs Filename:=strFolderName & "\traité\" & nom & ".xls"
    Workbooks(nom & ".xls").Close
    nb = nb + 1
  Next oFile
  MsgBox "fichiers modifiés : " & nb
End Sub

Qui prend donc chaque document de P:\Documents\test et les enregistre en xls dans P:\Documents\test\traité

Bonne journée.

Re-bonjour

je viens de tester , mais il y a un autre message d'erreur qui s'affiche : "Erreur d'exécution '1004': erreur définie par l'application ou par l'objet"

voici mon fichier xml en pièce jointe

Merci ELhevan , votre code me donne le même résultat que la première macro que j'ai essayée ( les noms des colonnes avec des /)

re-bonjour,

c'est plus facile quand on de quoi tester.

Sub xml()
'
' xml Macro
'

Dim f As String
Dim wbk As Workbook
Dim s As Integer
Dim nm As String, pathxml As String, pathxl As String
Set wbk = ThisWorkbook
pathxml = Workbooks(wbk.Name).Path & "\XML\"
pathxl = Workbooks(wbk.Name).Path & "\EXCEL\"
f = Dir(pathxml & "\*.xml")
s = 0

Do While Len(f) > 0
    s = s + 1
    Workbooks.Add
    ActiveWorkbook.XmlImport _
        URL:=pathxml & f, _
        ImportMap:=Nothing, _
        Overwrite:=True, _
        Destination:=Sheets(1).Range("$A$1")
   sheets(1).SaveAs Filename:=pathxl & Replace(f, ".xml", ".xls")
    f = Dir()
    ActiveWorkbook.Close False
Loop

'
End Sub

MERCI INFINIMENT , ça marche à merveille , vous me sauvez un temps fou

Merci à vous