Comment parsingr le XML en utilisant vba

Je travaille en VBA et je veux parsingr une chaîne, par exemple

 24.365 78.63  

et obtenir les valeurs X & Y dans deux variables entières distinctes.

Je suis un novice en matière de XML, car je suis coincé dans VB6 et VBA, en raison du domaine dans lequel je travaille.

Comment puis-je faire cela?

C’est une question un peu compliquée, mais il semblerait que la voie la plus directe serait de charger le document XML ou la chaîne XML via MSXML2.DOMDocument qui vous permettrait alors d’accéder aux nœuds XML.

Vous pouvez en trouver plus sur MSXML2.DOMDocument sur les sites suivants:

Merci pour les conseils.

Je ne sais pas si c’est la meilleure approche du problème ou non, mais voici comment je l’ai fait fonctionner. J’ai référencé le dll Microsoft XML, v2.6 dans mon VBA, puis l’extrait de code suivant me donne les valeurs requirejses

 Dim objXML As MSXML2.DOMDocument Set objXML = New MSXML2.DOMDocument If Not objXML.loadXML(strXML) Then 'strXML is the ssortingng with XML' Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason End If Dim point As IXMLDOMNode Set point = objXML.firstChild Debug.Print point.selectSingleNode("X").Text Debug.Print point.selectSingleNode("Y").Text 

Ajoutez la référence Project-> Références Microsoft XML, 6.0 et vous pouvez utiliser un exemple de code:

  Dim xml As Ssortingng xml = "Me    No Name  " Dim oXml As MSXML2.DOMDocument60 Set oXml = New MSXML2.DOMDocument60 oXml.loadXML xml Dim oSeqNodes, oSeqNode As IXMLDOMNode Set oSeqNodes = oXml.selectNodes("//root/person") If oSeqNodes.length = 0 Then 'show some message Else For Each oSeqNode In oSeqNodes Debug.Print oSeqNode.selectSingleNode("name").Text Next End If 

soyez prudent avec xml node // Root / Person n’est pas le même avec // root / person, sélectionnez aussi SingleNode (“Name”). texte est différent de selectSingleNode (“name”). text

Voici un exemple d’parsingur OPML fonctionnant avec des fichiers opd FeedDemon:

 Sub debugPrintOPML() ' http://msdn.microsoft.com/en-us/library/ms763720(v=VS.85).aspx ' http://msdn.microsoft.com/en-us/library/system.xml.xmlnode.selectnodes.aspx ' http://msdn.microsoft.com/en-us/library/ms256086(v=VS.85).aspx ' expressions ' References: Microsoft XML Dim xmldoc As New DOMDocument60 Dim oNodeList As IXMLDOMSelection Dim oNodeList2 As IXMLDOMSelection Dim curNode As IXMLDOMNode Dim n As Long, n2 As Long, x As Long Dim strXPathQuery As Ssortingng Dim attrLength As Byte Dim FilePath As Ssortingng FilePath = "rss.opml" xmldoc.Load CurrentProject.Path & "\" & FilePath strXPathQuery = "opml/body/outline" Set oNodeList = xmldoc.selectNodes(strXPathQuery) For n = 0 To (oNodeList.length - 1) Set curNode = oNodeList.Item(n) attrLength = curNode.Atsortingbutes.length If attrLength > 1 Then ' or 2 or 3 Call processNode(curNode) Else Call processNode(curNode) strXPathQuery = "opml/body/outline[position() = " & n + 1 & "]/outline" Set oNodeList2 = xmldoc.selectNodes(strXPathQuery) For n2 = 0 To (oNodeList2.length - 1) Set curNode = oNodeList2.Item(n2) Call processNode(curNode) Next End If Debug.Print "----------------------" Next Set xmldoc = Nothing End Sub Sub processNode(curNode As IXMLDOMNode) Dim sAttrName As Ssortingng Dim sAttrValue As Ssortingng Dim attrLength As Byte Dim x As Long attrLength = curNode.Atsortingbutes.length For x = 0 To (attrLength - 1) sAttrName = curNode.Atsortingbutes.Item(x).nodeName sAttrValue = curNode.Atsortingbutes.Item(x).nodeValue Debug.Print sAttrName & " = " & sAttrValue Next Debug.Print "-----------" End Sub 

Celui-ci prend des arbres à plusieurs niveaux de dossiers (Awasu, NewzCrawler):

 ... Call xmldocOpen4 Call debugPrintOPML4(Null) ... Dim sText4 As Ssortingng Sub debugPrintOPML4(strXPathQuery As Variant) Dim xmldoc4 As New DOMDocument60 'Dim xmldoc4 As New MSXML2.DOMDocument60 ' ? Dim oNodeList As IXMLDOMSelection Dim curNode As IXMLDOMNode Dim n4 As Long If IsNull(strXPathQuery) Then strXPathQuery = "opml/body/outline" ' http://msdn.microsoft.com/en-us/library/ms754585(v=VS.85).aspx xmldoc4.async = False xmldoc4.loadXML sText4 If (xmldoc4.parseError.errorCode <> 0) Then Dim myErr Set myErr = xmldoc4.parseError MsgBox ("You have error " & myErr.reason) Else ' MsgBox xmldoc4.xml End If Set oNodeList = xmldoc4.selectNodes(strXPathQuery) For n4 = 0 To (oNodeList.length - 1) Set curNode = oNodeList.Item(n4) Call processNode4(strXPathQuery, curNode, n4) Next Set xmldoc4 = Nothing End Sub Sub processNode4(strXPathQuery As Variant, curNode As IXMLDOMNode, n4 As Long) Dim sAttrName As String Dim sAttrValue As String Dim x As Long For x = 0 To (curNode.Attributes.length - 1) sAttrName = curNode.Attributes.Item(x).nodeName sAttrValue = curNode.Attributes.Item(x).nodeValue 'If sAttrName = "text" Debug.Print strXPathQuery & " :: " & sAttrName & " = " & sAttrValue 'End If Next Debug.Print "" If curNode.childNodes.length > 0 Then Call debugPrintOPML4(strXPathQuery & "[position() = " & n4 + 1 & "]/" & curNode.nodeName) End If End Sub Sub xmldocOpen4() Dim oFSO As New FileSystemObject ' Microsoft Scripting Runtime Reference Dim oFS Dim FilePath As Ssortingng FilePath = "rss_awasu.opml" Set oFS = oFSO.OpenTextFile(CurrentProject.Path & "\" & FilePath) sText4 = oFS.ReadAll oFS.Close End Sub 

ou mieux:

 Sub xmldocOpen4() Dim FilePath As Ssortingng FilePath = "rss.opml" ' function ConvertUTF8File(sUTF8File): ' http://www.vbmonster.com/Uwe/Forum.aspx/vb/24947/How-to-read-UTF-8-chars-using-VBA ' loading and conversion from Utf-8 to UTF sText8 = ConvertUTF8File(CurrentProject.Path & "\" & FilePath) End Sub 

mais je ne comprends pas pourquoi xmldoc4 devrait être chargé à chaque fois.

Vous pouvez utiliser une requête XPath:

 Dim objDom As Object '// DOMDocument Dim xmlStr As Ssortingng, _ xPath As Ssortingng xmlStr = _ " " & _ " 24.365 " & _ " 78.63 " & _ "" Set objDom = CreateObject("Msxml2.DOMDocument.3.0") '// Using MSXML 3.0 '/* Load XML */ objDom.LoadXML xmlStr '/* ' * XPath Query ' */ '/* Get X */ xPath = "/PointN/X" Debug.Print objDom.SelectSingleNode(xPath).text '/* Get Y */ xPath = "/PointN/Y" Debug.Print objDom.SelectSingleNode(xPath).text 

Voici un bref aperçu pour parsingr un fichier XML MicroStation Triforma qui contient des données pour des formes d’acier de structure.

 'location of sortingforma structural files 'c:\programdata\bentley\workspace\sortingforma\tf_imperial\data\us.xml Sub ReadTriformaImperialData() Dim txtFileName As Ssortingng Dim txtFileLine As Ssortingng Dim txtFileNumber As Long Dim Shape As Ssortingng Shape = "w12x40" txtFileNumber = FreeFile txtFileName = "c:\programdata\bentley\workspace\sortingforma\tf_imperial\data\us.xml" Open txtFileName For Input As #txtFileNumber Do While Not EOF(txtFileNumber) Line Input #txtFileNumber, txtFileLine If InStr(1, UCase(txtFileLine), UCase(Shape)) Then P1 = InStr(1, UCase(txtFileLine), "D=") D = Val(Mid(txtFileLine, P1 + 3)) P2 = InStr(1, UCase(txtFileLine), "TW=") TW = Val(Mid(txtFileLine, P2 + 4)) P3 = InStr(1, UCase(txtFileLine), "WIDTH=") W = Val(Mid(txtFileLine, P3 + 7)) P4 = InStr(1, UCase(txtFileLine), "TF=") TF = Val(Mid(txtFileLine, P4 + 4)) Close txtFileNumber Exit Do End If Loop End Sub 

De là, vous pouvez utiliser les valeurs pour dessiner la forme dans MicroStation 2d ou le faire en 3D et extruder le en un solide.

Mettre à jour

La procédure présentée ci-dessous donne un exemple d’parsing XML avec VBA à l’aide des objects DOM XML. Le code est basé sur un guide de débutant du DOM XML .

 Public Sub LoadDocument() Dim xDoc As MSXML.DOMDocument Set xDoc = New MSXML.DOMDocument xDoc.validateOnParse = False If xDoc.Load("C:\My Documents\sample.xml") Then ' The document loaded successfully. ' Now do something intersting. DisplayNode xDoc.childNodes, 0 Else ' The document failed to load. ' See the previous listing for error information. End If End Sub Public Sub DisplayNode(ByRef Nodes As MSXML.IXMLDOMNodeList, _ ByVal Indent As Integer) Dim xNode As MSXML.IXMLDOMNode Indent = Indent + 2 For Each xNode In Nodes If xNode.nodeType = NODE_TEXT Then Debug.Print Space$(Indent) & xNode.parentNode.nodeName & _ ":" & xNode.nodeValue End If If xNode.hasChildNodes Then DisplayNode xNode.childNodes, Indent End If Next xNode End Sub 

Nota Bene – Cette réponse initiale montre la chose la plus simple que je puisse imaginer (à l’époque, je travaillais sur un problème très spécifique). Bien entendu, utiliser les fonctionnalités XML intégrées à VBA XML Dom serait bien meilleure. Voir les mises à jour ci-dessus.

Réponse originale

Je sais que c’est un message très ancien mais je voulais partager ma solution simple à cette question compliquée. J’ai principalement utilisé des fonctions de chaîne de base pour accéder aux données XML.

Cela suppose que vous ayez des données xml (dans la variable temp) qui ont été renvoyées dans une fonction VBA. Chose intéressante, on peut également voir comment je suis en train de créer un lien vers un service Web xml pour récupérer la valeur. La fonction affichée dans l’image prend également une valeur de recherche car cette fonction Excel VBA est accessible depuis une cellule en utilisant = NomFonction (valeur1, valeur2) pour renvoyer des valeurs via le service Web dans une feuille de calcul.

fonction d'échantillon

 openTag = "< " & tagValue & ">" closeTag = "< /" & tagValue & ">" 
' Locate the position of the enclosing tags startPos = InStr(1, temp, openTag) endPos = InStr(1, temp, closeTag) startTagPos = InStr(startPos, temp, ">") + 1 ' Parse xml for returned value Data = Mid(temp, startTagPos, endPos - startTagPos)

Il est souvent plus facile d’parsingr sans VBA, lorsque vous ne voulez pas activer les macros. Cela peut être fait avec la fonction remplacer. Entrez vos nœuds de début et de fin dans les cellules B1 et C1.

 Cell A1: {your XML here} Cell B1:  Cell C1:  Cell D1: =REPLACE(A1,1,FIND(A2,A1)+LEN(A2)-1,"") Cell E1: =REPLACE(A4,FIND(A3,A4),LEN(A4)-FIND(A3,A4)+1,"") 

Et la ligne de résultat E1 aura votre valeur analysée:

 Cell A1: {your XML here} Cell B1:  Cell C1:  Cell D1: 24.36578.68 Cell E1: 24.365