Discussion :

[Invité]

Bonjour,
http://www.freevbcode.com/ShowCode.asp?ID=1204

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Public Function LoadRsFromXML(FullPath As String) As Object
 
'**************************************************
'PURPOSE: LOAD A RECORDSET FROM AN XML FILE USING
'ADO 2.5.  THE XML FILE MUST HAVE BEEN SAVED
'USING SAVE METHOD OF RECORDSET OBJECT WITH adPersistXML AD
'SECOND PARAMETER
 
'PARAMETERS:
 'FullPath:     FullPath of XMLFile to load
 
'RETURNS:       Reference to a Recordset Object, or Nothing if
'               Function fails
'REQUIRES:      Installation of and reference to ADO 2.5
'EXAMPLE:       See Example for SaveRsToXML
 
'******************************************************
 
Dim oRs As Object
Set oRs = CreateObject("ADODB.Recordset")
On Error Resume Next
Const adCmdFile = 256
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
If Dir(FullPath) = "" Then Exit Function
oRs.Open FullPath, "Provider=MSPersist;", adOpenForwardOnly, _
    adLockReadOnly, adCmdFile
 
If Err.Number = 0 Then
    Set LoadRsFromXML = oRs
End If
 
End Function
Sub test()
Set a = LoadRsFromXML("C:\Users\Robert\Desktop\Fichier.xml")
For i = 0 To a.Fields.Count - 1
 Range("A1").Offset(0, i) = a(i).Name
Next
Range("A2").CopyFromRecordset a
End Sub

[steph6499]

Bonjour Patrick,

le contrôle que je dois effectuer est assez conséquent : comparaison de chaque champ de chaque ligne de SAP et du fichier XML, contrats en trop, contrats manquants entre les deux. Beaucoup d'échanges de contrats créés ou modifiés entre SAP et le site internet nécessitent une comparaison de chaque info du contrat pour vérifier que tous les échanges fonctionnent bien.
Les imports eux-mêmes ne sont pas à contrôler : ils me servent, l'un à voir les données de SAP, l'autre à voir les données du site, pour comparaison des deux pour vérifier s'ils sont cohérents ou si j'ai des soucis dans les échanges entre SAP et le site internet.

Ce que j'ai fait au départ :

- côté SAP (extraction SAP en xls) : monTableauSAP = extractionSAP.range(...)

- côté XML : monTableauXML = --> et là comme je ne connais pas bien la méthode je lis le fichier xml et récupère tous les nodes et subnodes : c'est çà qui me prend du temps vu la taille du fichier (mais pour mes autres fichiers xml beaucoup plus légers je n'ai aucun souci).
Mais si je peux récupérer en un bloc mon fichier xml dans monTableauXML, je suis preneuse (mais je trouve très peu d'explication sur le langage XML par VBA sur internet, je ne sais pas ce qu'il est possible de faire, d'où la méthode de lecture XML choisie car c'est la seule que j'ai réussi à adapter ).

- dans ma macro, je travaille les tableaux monTableauSAP et monTableauXML pour avoir les données dans le même ordre et au même format, puis j'affiche tout çà dans un tableau Excel avec une colonne source (XML ou SAP). Cette base commune me permet ensuite de faire des contrôles par des tableaux croisés qui devraient faire apparaître les écarts entre les deux sources sur tel ou tel "champ".

Bonjour rdurupt,

j'ai copié le code et ai juste changé l'adresse et nom du fichier, mais il plante et me dit que l'objet a = Nothing.
Ci dessous, l'extrait du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
Set a = LoadRsFromXML("C:\Users\Stéphanie\Desktop\Fichiers exportés\Contrat.xml")
For i = 0 To a.Fields.Count - 1
 Range("A1").Offset(0, i) = a(i).Name
Next
Range("A2").CopyFromRecordset a
End Sub

[Invité]

Désolé,j'avais fait quelque essai qui avait été concluant!

Je regarde, ça présentait l'avantage de pouvoir filtrer les données mais a priori ça fonctionne pas sur tous les xml. Je cherche et je te dis!

[steph6499]

Merci de ton aide (j'essaie de comprendre pendant ce temps les recordset...).

[patricktoulon]

re
serait ce possible d'avoir les 100 premières lignes du xml?
et un aperçu du résultat souhaité

[steph6499]

re
serait ce possible d'avoir les 100 premières lignes du xml?
et un aperçu du résultat souhaité

Patrick,

ci-joint un extrait du fichier. Je ne pense pas qu'il y ait 100 lignes, mais tout se ressemble ensuite (et j'avoue que sélectionner les données dans le bloc note ne me permettait pas de compter...). Il y a des balises "Contrat" puis des sous-balises avec les détails contractuels de chacun : année, prix, dates...

Le résultat attendu est simple : Récupérer les données dans un tableau variable à 2 dimensions. Dans l'idéal, possibilité de récupérer les contrats pour une valeur donnée de l'année (par exemple), c'est-à-dire ne récupérer les données d'un contrat que lorsque l'année est égale à une certaine valeur (mais j'imagine que le fait de chercher çà est encore plus long...?)

Si besoin de plus d'infos ou de plus de données dans le fichier, dis-le-moi. Merci d'avance en tous cas.

[patricktoulon]

allez comme a mon abitude je te propose de sortir des sentiers balisé /battus

vu que la structure est relativement simple
je t'ai transformé en deux coup de cuillère a pots ton xml en html et retranscrit sur le sheets 1 contrat et tout le tointoin par ligne
tu t'en sortira pour le reste ?
pas compliqué!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub test()
    Dim laChaine As String, x, fichier As String
    fichier = "C:\Users\polux\Desktop\ContratExtrait.xml"
    x = FreeFile
    Open fichier For Input As #x
    laChaine = Input(LOF(x), #x)
    Close #x
    ligne = Split(laChaine, vbCrLf)
    For i = 1 To UBound(ligne)
        deb = IIf(i > 1, "</TR>", "")
        If InStr(ligne(i), "<Contrat") > 0 Then
            ligne(i) = deb & vbCrLf & "<TR class=Contrat>" & vbCrLf
        Else
            If Left(ligne(i), 3) <> "<tr" Then ligne(i) = Replace(ligne(i), "<", "<TD id =")
            ligne(i) = Split(ligne(i), "<TD id =/")(0)
            ligne(i) = ligne(i) & "</TD>"
        End If
        If ligne(i) = "  </TD>" Then ligne(i) = ""
        code = code & ligne(i) & vbCrLf
    Next
    code = "<Table>" & Replace(code, "/>", ">") & "</TR></table>"
    Debug.Print code
    With CreateObject("htmlfile")
        If .parentWindow.clipboardData.setData("Text", code) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells(1, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

teste cela avec ton xml
tu pourra travailler tes ligne comme tu veux après

tiens pour que cela soit plus clair je t'ai fait les entêtes de colonne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Sub test()
    Dim laChaine As String, x, fichier As String
    fichier = "C:\Users\polux\Desktop\ContratExtrait.xml"
    x = FreeFile
    Open fichier For Input As #x
    laChaine = Input(LOF(x), #x)
    Close #x
    ligne = Split(laChaine, vbCrLf)
    For i = 1 To UBound(ligne)
        deb = IIf(i > 1, "</TR>", "")
        If InStr(ligne(i), "<Contrat") > 0 Then
            ligne(i) = deb & vbCrLf & "<TR class=Contrat>" & vbCrLf
        Else
            If Left(ligne(i), 3) <> "<tr" Then ligne(i) = Replace(ligne(i), "<", "<TD id =")
            ligne(i) = Split(ligne(i), "<TD id =/")(0)
            ligne(i) = ligne(i) & "</TD>"
        End If
        If ligne(i) = "  </TD>" Then ligne(i) = ""
        code = code & ligne(i) & vbCrLf
    Next
    code = "<Table>" & Replace(code, "/>", ">") & "</TR></table>"
    Debug.Print code
    With CreateObject("htmlfile")
        .body.innerhtml = code
        For e = 0 To .getelementsbytagname("TR")(1).Children.Length - 1
        entete = entete & .getelementsbytagname("TR")(1).Children(e).ID & " "
        Next
        ent = Split(entete, " ")
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                Cells(1, 1).Resize(1, UBound(ent)) = ent
                .Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub

[steph6499]

Patrick,

merci pour ce retour!!!

En parallèle, j'ai également trouvé une "bidouille" qui ressemble un peu à la tienne (dans la logique quoi...) :
- intégration contenu fichier dans variable --> copié-collé d'un code trouvé par hasard sur internet...
- puis décomposition en ligne avec séparateur "<Contrat>"
- puis décomposition de chaque ligne en colonne avec séparateur vbCrLf (je bloquais sur la tabulation, puis j'ai vu vers minuit que tu m'avais répondu, et que toi tu avais le bon séparateur!)
- puis travail sur chaine de caractères pour ignorer les balises
- puis intégration dans tableau variable

J'ai quelques détails/cas particuliers à régler dans le travail des chaines, mais je suis pas loin, et le temps d'exécution est d'environ 1 minutes 30.
En espérant que le code est assez "propre"...
Là je m'arrête, mais je regarderai également ce que donne ton code.
Merci en tous cas !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub avecSplit()
 
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strXml As String
strXml = FSO.OpenTextFile("C:\Users\Stéphanie\Desktop\Fichiers exportés\Contrat.xml").ReadAll
 
Dim tabDonnees() As Variant
Dim Ar() As String
Dim Ar2() As String
Dim ligne As Long
Dim colonne As Integer
Dim monTexte As String
'Range("A1") = strXml
 
 
Ar = Split(strXml, "</Contrat>")
For ligne = LBound(Ar) + 1 To UBound(Ar)
     ReDim Preserve tabDonnees(110, ligne)
     Range("A1") = ligne
     Ar2 = Split(Ar(ligne), vbCrLf)
     For colonne = LBound(Ar2) + 1 To UBound(Ar2)
         monTexte = Trim(Ar2(colonne))
         If monTexte <> "" And monTexte <> "<Contrat>" And monTexte <> "</DataExport>" And InStr(1, monTexte, "/>") = 0 Then
            tabDonnees(colonne - 1, ligne) = Mid(monTexte, InStr(1, monTexte, ">") + 1, InStr(2, monTexte, "<") - InStr(1, monTexte, ">") - 1)
            'tabDonnees(colonne - 1, ligne) = monTexte
         End If
     Next colonne
Next ligne

[patricktoulon]

regarde l'aperçu de mon résultat

[cerede2000]

Avec un fichier XML de 20Mo+ j'ai un doute que tout tienne dans un string VBA ?!?
Si ?

[Marc-L]

Salut !

Du moment que cela n'atteint pas les 2 milliards de caractères, cela peut tenir dans un string mais cela va ramer !

______________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

[cerede2000]

Heu il me semble bien déjà qu'avant d'atteindre le milliard on obtient une erreur de dépassement de capacité.

[Invité]

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Public Function LoadRsFromXML(FullPath As String) As Object
 
'**************************************************
'PURPOSE: LOAD A RECORDSET FROM AN XML FILE USING
'ADO 2.5.  THE XML FILE MUST HAVE BEEN SAVED
'USING SAVE METHOD OF RECORDSET OBJECT WITH adPersistXML AD
'SECOND PARAMETER
 
'PARAMETERS:
 'FullPath:     FullPath of XMLFile to load
 
'RETURNS:       Reference to a Recordset Object, or Nothing if
'               Function fails
'REQUIRES:      Installation of and reference to ADO 2.5
'EXAMPLE:       See Example for SaveRsToXML
 
'******************************************************
 
Dim oRs As Object, adoConn As Object
Set GetXMLDB = CreateObject("ADODB.Connection")
 
With GetXMLDB
.Open "Provider=MSDAOSP; Data Source=MSXML2.DSOControl;"
End With
Set oRs = CreateObject("ADODB.Recordset")
On Error Resume Next
Const adCmdFile = 256
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
If Dir(FullPath) = "" Then Exit Function
oRs.Open FullPath, GetXMLDB
 
If Err.Number = 0 Then
    Set LoadRsFromXML = oRs
End If
 
End Function
Sub test()
Set rs = LoadRsFromXML("C:\Users\rdurupt\Desktop\ContratExtrait.xml")
For i = 0 To rs.Fields.Count - 1
 Range("A1").Offset(0, i) = rs(i).Name
Next
rs.Filter = "IdOffre=129"
Range("A2").CopyFromRecordset rs
End Sub

[patricktoulon]

Bonjour
ca fonctionne rdurupt légèrement plus rapide on dirait

si tu supprime la ligne rs.filter tu a tout

maintenant puisque c'est sensé être pour contrôler ce qui a déjà par SAP comment pourrait -on mettre le résultat de "rs.filter" dans un tableau ou même un string ???? plutôt que de l'injecter dans le sheets

[Invité]

bonjour Patrick,

soit tu définis Sap comme fil conducteur soit Rs!

mais connaissance sur SAP sont plus que limitées donc nous nous appuierons a notre amis.

scannons le recordSet!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Set rs = LoadRsFromXML("C:\Users\rdurupt\Desktop\ContratExtrait.xml")
while rs.eof=false
  if  FunctionTesSap(r("IdContrat").value,Rs)=false then msgbox "Pas trouvé" 'je par du principe que nous retournons un table Sap et que nous le comparon à tio les champs For i = 0 To rs.Fields.Count - 1!
rs.movenext
wend

Scan Sap Filtre Rs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Set rs = LoadRsFromXML("C:\Users\rdurupt\Desktop\ContratExtrait.xml")
      if rs.eof=false then
         Do while BoucleSap.eof=false
            rs.filter="": rs.movefirst 
            tableaur =FunctionLectureSapSuivant
            rs.filter="IdContrat=" &  tableaur (0)
            if rs.eof=false
               for i=0 to ubound(tableaur )
                    if rs(i).value<> tableaur (i) then msgbox "Différant": exit for
               next
            end if
 
      loop
end if

maintenant on atteint mon ignorance sur Sap et je ne sais pas comment l'interroger je ne peux donner qu'une piste!

[patricktoulon]

attention quand meme sur certain format xml (interne"=") les colonnes sont inversées

<?xml version="1.0" encoding="UTF-8"?>
<tags><resource checksum="a7f02530d3bc7484c8f9240cbe9c65b1" identifier="${gimp_data_dir}/brushes/Round.vbr"><tag>Arrondi</tag></resource><resource checksum="f8cb2466841104a55e42afce4568d103" identifier="${gimp_data_dir}/brushes/Round-Fuzzy.vbr"><tag>Flou</tag><tag>Arrondi</tag></resource><resource checksum="157dcef48665ab465439cfaf10d6feeb" identifier="gimp-brush-clipboard"> </resource>

je me retrouve avec identifier en 1 er colonne et checsoum en 2

[Invité]

l'avantage du recordset c'est que l'inversion tu t'en fiche!

note que du certaine manière ton table c'est Rs!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rs.Filter = "IdOffre=129"

[patricktoulon]

et oui mais si Sazp respecte les colonnes
comment chercher la valeur de par exemple "IdExtEngagement"

perso moi je filtre par exemple " idcontrat=8882 "
ensuite il faut trouver comment cibler la colonne "IdExtEngagement" de la ligne idcontrat filtrée

[Invité]

tu peux faire une requête Sap à vide pour faire l'apprentissage du colonage Dico

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

IdExtEngagement=dico("IdExtEngagement")

[patricktoulon]

et oui je m'en doutais
c'est pour cela que j'ai préféré des le départ la conversion html car dans mon principe le id de la TD c'est l'entête de colonne
il faut modifier le replace "<contrat" pour le "TR" en y ajoutant la valeur de idcontrat
comme ca on cherche le id contrat (xxx) avec getelementsbyid et le id (nom de colonne)pour cette ligne idcontrat
je regarde ca tout a l'heure je pars en inter la