import fichier XML

[danval]

bonjour à tous,

je suis débutant en VBA et je réalise mes fichiers en prenant des bout de code à droite et à gauche et en les adaptant à ce que je veux mais cela à ces limites.

je travaille sur un projet afin de voir en "live" la planification des travaux.

j'ai réalisé un fichier qui exporte un fichier xml par feuille dans un répertoire portant le nom de la feuille.
celui-ci fonctionne trés bien.


voila mon code d'exportation:

Sub ExportDesDonneesXML()
 
On Error Resume Next
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
 
Dim Chemin As String
Dim Nom As String
Dim Fichier As String
Dim numfile As Integer
Dim i As Integer
 
Chemin = "N:\MOYENS GENERAUX\Imprimerie\FichiersXMLindicateurs\XML\communication\janvier\"
Nom = ActiveWorkbook.Name
Nom = Split(Nom, ".")(0)                                            'On prend le nom du fichier courant sans son extension .xls
Fichier = Chemin & Nom & ".xml"
 
numfile = FreeFile
Open Fichier For Output As #numfile
Print #numfile, "<?xml version='1.0'  encoding='ISO-8859-1' ?>"
Print #numfile, "<releves>"
i = 10
    While Cells(i, 6) <> ""
        Print #numfile, "<factures>"
            Print #numfile, "<numFacture>" & Cells(i, 1) & "</numFacture>"
            Print #numfile, "<date>" & Cells(i, 2) & "</date>"
            Print #numfile, "<C>" & Cells(i, 3) & "</C>"
            Print #numfile, "<service>" & Cells(i, 4) & "</service>"
            Print #numfile, "<numero>" & Cells(i, 5) & "</numero>"
            Print #numfile, "<intitule>" & Cells(i, 7) & "</intitule>"
            Print #numfile, "<machine>" & Cells(i, 8) & "</machine>"
            Print #numfile, "<couleur>" & Cells(i, 9) & "</couleur>"
            Print #numfile, "<rectoVerso>" & Cells(i, 10) & "</rectoVerso>"
            Print #numfile, "<brochure>" & Cells(i, 11) & "</brochure>"
            Print #numfile, "<formatFini>" & Cells(i, 12) & "</formatFini>"
            Print #numfile, "<nbreDePages>" & Cells(i, 13) & "</nbreDePages>"
            Print #numfile, "<attente>" & Cells(i, 14) & "</attente>"
            Print #numfile, "<nbreDExemplaires>" & Cells(i, 15) & "</nbreDExemplaires>"
            Print #numfile, "<O>" & Cells(i, 16) & "</O>"
            Print #numfile, "<papier>" & Cells(i, 17) & "</papier>"
            Print #numfile, "<Q>" & Cells(i, 18) & "</Q>"
            Print #numfile, "<typeDePapier>" & Cells(i, 19) & "</typeDePapier>"
            Print #numfile, "<S>" & Cells(i, 20) & "</S>"
            Print #numfile, "<NbreDeFeuilles>" & Cells(i, 21) & "</NbreDeFeuilles>"
            Print #numfile, "<feuillesOffset>" & Cells(i, 22) & "</feuillesOffset>"
            Print #numfile, "<V>" & Cells(i, 23) & "</V>"
            Print #numfile, "<NbreDeTours>" & Cells(i, 24) & "</NbreDeTours>"
            Print #numfile, "<X>" & Cells(i, 25) & "</X>"
            Print #numfile, "<montage>" & Cells(i, 26) & "</montage>"
            Print #numfile, "<Z>" & Cells(i, 27) & "</Z>"
            Print #numfile, "<NbreDePlaques>" & Cells(i, 28) & "</NbreDePlaques>"
            Print #numfile, "<AB>" & Cells(i, 29) & "</AB>"
            Print #numfile, "<NbreDexPlies>" & Cells(i, 30) & "</NbreDexPlies>"
            Print #numfile, "<Perfos>" & Cells(i, 31) & "</Perfos>"
            Print #numfile, "<NbreDexAssembles>" & Cells(i, 32) & "</NbreDexAssembles>"
            Print #numfile, "<miseSousPlis>" & Cells(i, 33) & "</miseSousPlis>"
            Print #numfile, "<AG>" & Cells(i, 34) & "</AG>"
            Print #numfile, "<couleur2>" & Cells(i, 35) & "</couleur2>"
            Print #numfile, "<prix>" & Cells(i, 36) & "</prix>"
        Print #numfile, "</factures>"
        i = i + 1
    Wend
 
Print #numfile, "</releves>"
Close #numfile
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
 
If (Err.Number <> 0) Then GoTo plantage   'gestion des erreurs afin de prévenir l'utilisateur
 
MsgBox "Les données XML ont bien été exportées.", vbOKOnly + vbInformation, "Message"
 
Exit Sub
 
plantage:
MsgBox "Une erreur s'est produite : l'export des données ne s'est pas passé correctement !", vbCritical
 
End Sub

j'ai aussi réalisé un autre fichier qui compte douze feuilles (une par mois).
je réalise l'importation grâce à un mappage de tout les fichiers XML d'un même répertoire dans la feuille portant le nom du répertoire et ceci bout à bout.
il fonctionne sur la feuille de janvier qui possède un mappage.

voici donc mon probléme:

j'ai donc fait une copie pour les onze autres mois de la feuille.

elles ont toute la même structure et le même mappage.

il y a deux choses que je n'arrive pas à faire:

1 - étendre la macro à toute les feuilles: charger les xml du répertoire février dans la feuille février,...

2 - lorsque je lance la macro elle ajoute le contenu des fichiers xml dans la feuille à la suite de ce qu'il y as déjà.
le problème est que le fichier importé est dèja présent dedans donc il y as doublon.
ce qu'il faudrait s'est effacer les feuilles avant de procédé à l'import.

comme il y as un mappage j'ai un cadre bleu qui suit les données et je n'arrive pas à effacer.


macro import:

Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 09/04/2013 par plancot daniel
'
 
'
On Error Resume Next
 
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
Dim Repertoire As String
Dim Fichier As String
Dim ws As Worksheet
 
'-------------- Retrait de la protection de tous les onglets ------------------------
For Each ws In ThisWorkbook.Worksheets
    ws.Unprotect Password:=""
Next ws
 
ActiveWorkbook.XmlMaps("commandesFournitures_Mappage").DataBinding.Refresh          'Appel pour mise à jour des données XML
 
Repertoire = "N:\MOYENS GENERAUX\Imprimerie\FichiersXMLindicateurs\xml\communication\janvier\"
Fichier = Dir(Repertoire & "*.xml")                                                 ' recherche des fichiers .xml dans le répertoire FichiersXMLindicateurs
 
While Fichier <> ""                                                                 ' On importe les données de tous les fichiers xml trouvés dans le mappage releves_Travaux_Imprimerie
    ThisWorkbook.XmlMaps("releves_Travaux_Imprimerie").Import URL:=Repertoire & Fichier
    If (Err.Number = 0) Then Kill (Repertoire & Fichier)                            'S'il n'y a pas eu de pb, une fois l'importation réalisée on suprime le fichier XML afin d'éviter les redondances de données
    Fichier = Dir()
Wend
 
 
    ActiveWorkbook.RefreshAll                                                       'Mise à jour de toutes les requêtes et des TxD
 
'------------------------ Remise en place de la protection des onglets ----------------
For Each ws In ThisWorkbook.Worksheets
    ws.Protect Password:="", DrawingObjects:=False, Contents:=True, Scenarios:=True _
        , UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next ws
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
 
If (Err.Number <> 0) Then GoTo plantage    'gestion des erreurs afin de prévenir l'utilisateur
 
MsgBox "Toutes les données ont été actualisées.", vbOKOnly + vbInformation, "Message"
 
Exit Sub
 
plantage:
MsgBox "Une erreur s'est produite : la mise à jour des données a échouée.", vbCritical
 
End Sub

une chose l'exportation n'utilise pas le mappage volontairement car il est utilisé par 6 personnes dont deux ou le mappage ne fonctionne pas sur leur MAC.

je joint à ce post un XML, mon fichier export et mon fichier import avec les macros dedans.

par avance merci pour votre aide trés précieuse.

Daniel


Regarde la pièce jointe Archive.zip

 

[Guest]

Re : import fichier XML

Bonjour,

tel que je comprends, ton problème, bien que ton zip ne contienne pas tous les éléments nécessaires (répertoires jan, fev..., fichier xml différents etc....):

Pour la question 1 : il faut que tu donnes un nom de mappage différent sur toutes tes feuilles ex "relevé_imprimerie_Jan","relevé_imprimerie_Fev" etc.

Pour la question 2 : Dans les propriétés des mappages(je ne sais plus où elles se trouvent sur 2003) choisir, remplacer les données existantes par les nouvelles données. Il te suffira de demander l'acutalisation des données, qui se fera automatiquement.

Quant au problème des posts MAC: je ne sais pas

Dans le zip-joint ton dossier en retour avec quelques modifications de la macro export pour qu'elle créer les repertoires pour (tests) dans le fichiers import les mappages xml pour Janvier et Février, avec des noms différents.

Il me semble,que pour une plus grande 'lisibilité' nommer les fichiers export_jan.xml, export_fev.xml à leur création serait moins confus.


A+

 

[danval]

Re : import fichier XML

bonjour,

j'ai donc:
- 12 répertoires janvier, fevrier, ...
- j'ai plusieurs fichiers XML qui arrivent dans ces répertoires (normalement 6 par répertoire)
- je veux importer chaque contenu de répertoire dans la feuille correspondant au nom du répertoire (fichiers du répertoire janvier dans la feuille janvier, ...) je pense que l'on peut faire une boucle mais je n'y arrive pas.

peux-tu me dire comment changer le nom du mappage dans chaque feuille?

merci pour les infos je regarde de mon coté pour avancer.

à bientôt

Daniel

 

[danval]

Re : import fichier XML

s'il te faut un fichier particulier tu me dis et je le post.

 

[Guest]

Re : import fichier XML

Re,

Regarde le post #2, je l'ai réédité et joint un zip.

A+

 

[danval]

Re : import fichier XML

super je regarde à cela cette après midi et je te tiens au courant

A+

 

[Guest]

Re : import fichier XML

Re,

Comme j'avais le temps et l'envie, j'ai réécris une macro d'exportation à partir de la bibliothèque Microsoft xml V5 .
Apparament cette référence est déjà chargée dans ton projet (par l' xmlAddin certainement).
Dans la macro export vérifier que l'ordre des éléménents correspond bien à tes étiquettes de colonnes.
La macro d'écriture (saveXml) permet de créer un fichier indenter et à l'xml bien formé. les éléments vides apparaissent sous cette forme: <nonElement />

Sub Export()
'variable XML document
Dim docxml As MSXML2.DOMDocument50 'doucment xml lui-même
Dim releves As IXMLDOMElement  'racine
Dim factures As IXMLDOMElement 'element de factures (devrait être au singulier à mon avis puisqu'il représente 1 facture)
'variables de fonctionnement
Dim Chemin As String, Nom As String, Fichier As String
Dim Ws As Worksheet
Dim i As Long
Dim j As Integer
'tableau des nom d'élément pour une facture
Dim t: t = Array("numFacture", "date", "C", "service", "numero", "intitule", "machine", "couleur", "rectoVerso", "brochure", _
                "formatFini", "nbreDePage", "attente", "nbreDExemplaires", "O", "papier", "Q", "typeDePapier", "S", _
                "NbreDeFeuilles", "feuillesOffset", "V", "NbreDeTours", "X", "montage", "Z", "NbreDePlaques", "AB", _
                "NbreDexPlies", "Perfos", "NbreDexAssembles", "miseSousPlis", "AG", "couleur2", "prix")
Chemin = ThisWorkbook.Path & "\"    '"N:\MOYENS GENERAUX\Imprimerie\FichiersXMLindicateurs\XML\communication\"
    Nom = ThisWorkbook.Name
    Nom = Left(Nom, InStrRev(Nom, ".")) & "xml"
    For Each Ws In ThisWorkbook.Worksheets
        With Ws
            'Création des noms de fichiers
            lemois = LCase(.Name)
            'If Dir(Chemin & lemois, vbDirectory) = "" Then MkDir Chemin & lemois
            Fichier = Chemin & lemois & "\" & Nom
            
            'Création du docXml et ajour de la processingInstruction
            Set docxml = New MSXML2.DOMDocument50
            docxml.appendChild docxml.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
            
            'Création de l'élément racine releves
            Set releves = docxml.createElement("releves")
            
            i = 9
            Do While .Cells(i, 6) <> ""
                'creation d'un element factures dans l'élément racine 'releves'
                Set factures = docxml.createElement("factures")
                For j = LBound(t) To UBound(t)
                    factures.appendChild(docxml.createElement(t(j))).Text = .Cells(i, j + 1)
                Next j
                releves.appendChild factures
                Set factures = Nothing
                i = i + 1
            Loop
            'Ajout de la racine et ses sous-elements au document xml
            docxml.appendChild releves
            XmlSave Fichier, docxml
            Fichier = ""
            Set docxml = Nothing
        End With
    Next Ws
End Sub
Sub XmlSave(FullFileName As String, xDoc As MSXML2.DOMDocument50)
Dim rdr As New MSXML2.SAXXMLReader, wrt As New MSXML2.MXXMLWriter
Dim ostream As Object: Set ostream = CreateObject("ADODB.STREAM")    'createobject pour ne pas référencer msAdodb
    ostream.Open
    ostream.Charset = "ISO-8859-1"
    wrt.indent = True
    wrt.Encoding = "ISO-8859-1"
    wrt.output = ostream
    Set rdr.contentHandler = wrt
    Set rdr.errorHandler = wrt
    rdr.Parse xDoc
    wrt.flush
    ostream.SaveToFile FullFileName, 2
    Set rdr = Nothing
    Set wrt = Nothing
   ' MsgBox "fichier '" & strLanguage & ".xml' sauvegarder dans: " & ThisWorkbook.Path & "\"
End Sub

A+

 

[danval]

Re : import fichier XML

rebonjour,

merci pour cette macro j'aimerais pouvoir en faire autant et aussi rapidement.

je viens d'essayer ta macro et j'ai une erreur de syntax sur la ligne

Dim releves As IXMLDOMElement

de mon coté j'ai retravaillé le fichier d'importation:

1 - je ne peux pas faire comme tu me l'as dit plus haut une actualisation des données au niveau du mappage car sinon il m'importe un fichier puis pour le deuxième il écrit sur le premier alors que je veux les fichiers les uns derrière les autres vu qu'ils sont tous différents.

donc là la macro fonctionne bien il importe les fichiers bout à bout mais le problème est que si je relance un import il me réécrit les même données à la suite donc j'ai deux fois la même chose.

il faut donc que la macro efface les données xml dans chaque feuille avant de les réimporter (les données changent régulièrement suivant l'avancement des dossiers clients).


j'ai nommé les mappages : releves_Mappage_"mois"

est-il possible de faire une boucle afin d'utiliser la même routine pour charger les xml sur les 12 feuilles
par exemple avec une variable "feuille" qui reprend le nom de la feuille et qui serviras à alimenter le nom du répertoire et celui du mappage dans la macro.
pour le moment la macro fonctionne sur janvier on a donc explicitement "janvier" écrit dans la macro.

voila je continu à chercher et je reviens s'il y as du nouveau.


encore merci pour ton investissement car beaucoup de personnes sur d'autre forum mon envoyé dans les roses.
ils ne comprennent pas que l'on ne peut pas avoir le savoir absolu.

je te joint le fichier archive modifié.


A+

Regarde la pièce jointe Archive.zip

 

[Guest]

Re : import fichier XML

Re,

Pourrais-tu expliciter, avec un exemple:

1 - je ne peux pas faire comme tu me l'as dit plus haut une actualisation des données au niveau du mappage car sinon il m'importe un fichier puis pour le deuxième il écrit sur le premier alors que je veux les fichiers les uns derrière les autres vu qu'ils sont tous différents.

C'est normal, le mappage xml est lié à un fichier. si ce fichier comporte les anciennes données + nouvelles données, les nouvelles seront importées sous les anciennes données MAIS si les données du fichier sont toutes nouvelles, elle ecrasent les anciennes. Cela ne peut pas être autrement avec le mappage

Si tu veux importer des données à partir de fichiers reconstruits il faut écrire une routine de traitement xml.

Pour ce qui concerne l'erreur: dans l'éditeur VBA menu Outils>Références, dans la liste, choisir Microsoft xml v 5.0
Sinon, je ne vois pas.

A+

 

[danval]

Re : import fichier XML

en fait il n'inscrit dessous que les données différentes par contre si les données à importées sont identique il ne fait rien.

et si une case change il corrige juste cette case.

 

[danval]

Re : import fichier XML

prends le fichier import et lance la macro deux fois de suite.

tu verras que les données sont deux fois dans la feuille de janvier malgrés que les trois fichiers xml non pas changé.

c'est cela que je veux contourner en effacent la feuille avant l'import

 

[Guest]

Re : import fichier XML

Re,

Comme je n'ai plus accès à xl2003 depuis longtemps, je suis obligé de faire des recherches. Je pense que la macro ci-dessous répond à ton besoin, testée avec les fichiers du dernier zip que tu as joint.

Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 05/10/2013 par PLANCOT DANIEL
'
'
    On Error Resume Next
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim Repertoire As String
    Dim Fichier As String
    Dim ws As Worksheet
    Dim nomFeuille As String
    '-------------- Retrait de la protection de tous les onglets ------------------------
    For Each ws In ThisWorkbook.Worksheets(Array("janvier", "fevrier", "mars", "avril", "mai", "juin", "juillet", "aout", "septembre", "octobre", "novembre", "decembre"))
        ws.Unprotect Password:=""
        ws.ListObjects(1).DataBodyRange.Rows.Delete xlShiftUp
        nomFeuille = ws.Name
        Repertoire = ThisWorkbook.Path & "\" & nomFeuille & "\"
        Fichier = Dir(Repertoire & "*.xml")                                         ' recherche des fichiers .xml dans le répertoire FichiersXMLindicateurs
        While Fichier <> ""                                                         ' On importe les données de tous les fichiers xml trouvés dans le mappage releves_Travaux_Imprimerie
            
            ThisWorkbook.XmlMaps("releves_Mappage_" & nomFeuille).Import URL:=Repertoire & Fichier
            'If (Err.Number = 0) Then Kill (Repertoire & Fichier)                    'S'il n'y a pas eu de pb, une fois l'importation réalisée on suprime le fichier XML afin d'éviter les redondances de données
            Fichier = Dir()
        Wend
    Next ws
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    If (Err.Number <> 0) Then GoTo plantage    'gestion des erreurs afin de prévenir l'utilisateur
    MsgBox "Toutes les données ont été actualisées.", vbOKOnly + vbInformation, "Message"
    Exit Sub
plantage:
    MsgBox "Une erreur s'est produite : la mise à jour des données a échouée.", vbCritical
End Sub

A+

 

[Staple1600]

Re : import fichier XML

Bonjour à tous

Hasco
BBCODE t'a trahi

ThisWorkbook.XmlMaps("releves_Mappage_" & nomFeuille).Import URL:=Repertoire & Fichier
            'If (Err.Number = 0) Then Kill (Repertoire & Fichier)                    
'S'il n'y a pas eu de pb, une fois l'importation réalisée on suprime le fichier XML afin d'éviter les redondances de données

Au moins cela m'aura valu le plaisir de te croiser sur XLD

 

[danval]

Re : import fichier XML

bon je teste demain car là je dois partir.

merci pour toute ton aide.


Daniel

 

[danval]

Re : import fichier XML

Bonjour,


Merci à Hasco pour ce code.

Je suis parti de ce j’avais déjà fait et de ce que tu me proposais pour faire une compil des deux afin d’éviter de recopier bêtement mais d’essayer de comprendre et j’ai appris plein de choses alors merci.

L’import dans toutes les feuilles fonctionne à merveille.
Il y a juste un bug au niveau de la ligne qui je suppose sert à effacer chaque feuille avant l’import*:

ws.ListObjects(1).DataBodyRange.Row.Delete xlShiftUp

j'ai le message d'erreur suivant: "qualificateur incorrect"

et je ne trouve pas.

voici le code de ma macro:

Sub ActuDonneesClasseur()
'
' ActuDonneesClasseur Macro
' Macro enregistrée le 06/10/2013 par PLANCOT DANIEL
'

'
On Error Resume Next

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Repertoire As String
Dim Fichier As String
Dim ws As Worksheet
Dim lemois As String


'-------------- Retrait de la protection de tous les onglets ------------------------

For Each ws In ThisWorkbook.Worksheets(Array("janvier", "fevrier", "mars", "avril", "mai", "juin", "juillet", "aout", "septembre", "octobre", "novembre", "decembre"))

            ws.Unprotect Password:=""
            ws.ListObjects(1).DataBodyRange.Row.Delete xlShiftUp
        lemois = ws.Name

Repertoire = ThisWorkbook.Path & "\" & lemois & "\"
Fichier = Dir(Repertoire & "*.xml")                                                 ' recherche des fichiers .xml dans le répertoire FichiersXMLindicateurs

While Fichier <> ""                                                                 ' On importe les données de tous les fichiers xml trouvés dans le mappage releves_Travaux_Imprimerie
      
    ThisWorkbook.XmlMaps("releves_Mappage_" & lemois).Import URL:=Repertoire & Fichier
    If (Err.Number <> 0) Then Kill (Repertoire & Fichier)                            'S'il n'y a pas eu de pb, une fois l'importation réalisée on suprime le fichier XML afin d'éviter les redondances de données
    Fichier = Dir()
Wend
    
    Next ws
      
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

If (Err.Number <> 0) Then GoTo plantage    'gestion des erreurs afin de prévenir l'utilisateur

MsgBox "Toutes les données ont été actualisées.", vbOKOnly + vbInformation, "Message"

Exit Sub

plantage:
MsgBox "Une erreur s'est produite : la mise à jour des données a échouée.", vbCritical

End Sub

Daniel