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 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| Sub Bouton1_Cliquer()
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
ligne = 1
colonne = 1
Worksheets("Feuil1").Cells.Clear
'Dim xmlDoc As New DOMDocument
'..... Initialisation du parceur
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "false"
'Dim oNode As IXMLDOMElement
'Dim oElement As IXMLDOMElement
'Dim oChildren As IXMLDOMNodeList
'Dim oChild As IXMLDOMNode
'Dim oRoot As IXMLDOMNode
chemin = "K:\Informatique\Nom\Flux\Prefixe\2014"
If oFSO.FolderExists(chemin) Then
For Each oFolder In oFSO.GetFolder(chemin).subfolders
nomDossier = oFolder.Name
If xmlDoc.Load(chemin \ " & nomDossier \ " * .XML) Then
For Each oNode In xmlDoc.getElementsByTagName("VTE EAN")
'...............Compteur de lignes
intI = 6
'...............Entetes de colonnes
'...................Balise VTES
ActiveSheet.Cells(4, 1) = "VTE EAN"
ActiveSheet.Cells(4, 2) = "DPX"
ActiveSheet.Cells(4, 3) = "QTPT"
ActiveSheet.Cells(4, 4) = "CAPT"
ActiveSheet.Cells(4, 5) = "QTNPT"
ActiveSheet.Cells(4, 6) = "CANPT"
'...................Balise AVTGES
ActiveSheet.Cells(4, 7) = "UVC"
ActiveSheet.Cells(4, 8) = "TYPAV"
ActiveSheet.Cells(4, 9) = "NBAVPT"
ActiveSheet.Cells(4, 10) = "MTAVPT"
ActiveSheet.Cells(4, 11) = "NBAVNPT"
ActiveSheet.Cells(4, 12) = "MTAVNPT"
'.................Pour boucler dans les balises
For Each oElement In oNode.ChildNodes
'.................Pour passer par tous les noeuds filles de VTE EAN
Set oChlidren = oElement.ChildNodes
If oElement.nodeMane = "VTE EAN" Then
ActiveSheet.Cells(intI, 1) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "DPX" Then
ActiveSheet.Cells(intI, 2) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "QTPT" Then
ActiveSheet.Cells(intI, 3) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "CAPT" Then
ActiveSheet.Cells(intI, 4) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "QTNPT" Then
ActiveSheet.Cells(intI, 5) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "CANPT" Then
ActiveSheet.Cells(intI, 6) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "UVC" Then
ActiveSheet.Cells(intI, 7) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "TYPAV" Then
ActiveSheet.Cells(intI, 8) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "NBAVPT" Then
ActiveSheet.Cells(intI, 9) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "MTAVPT" Then
ActiveSheet.Cells(intI, 10) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "NBAVNPT" Then
ActiveSheet.Cells(intI, 11) = ochlid.nodeTypedValue
End If
If oElement.nodeMane = "MTAVNPT" Then
ActiveSheet.Cells(intI, 12) = ochlid.nodeTypedValue
End If
Next oElement
Next oNode
End If
Next
Else
Worksheets("Feuil1").Cells(i, 11).Value = "Chemin inexistant :chemin."
End If
'.....Drestruction de notre objet(parceur)
Set xmlDoc = Nothing
End Sub |
Partager