Come analizzare XML usando vba

Lavoro in VBA e voglio analizzare una stringa per es

 24.365 78.63  

e ottieni i valori X e Y in due variabili intere separate.

Sono un principiante quando si tratta di XML, dal momento che sono bloccato in VB6 e VBA, a causa del campo in cui lavoro.

Come faccio a fare questo?

Questa è una domanda complicata, ma sembra che il percorso più diretto sia il caricamento del documento XML o della stringa XML tramite MSXML2.DOMDocument che consentirà l’accesso ai nodes XML.

È ansible trovare ulteriori informazioni su MSXML2.DOMDocument nei seguenti siti:

Grazie per i suggerimenti.

Non so, se questo è l’approccio migliore al problema o no, ma ecco come ho potuto farlo funzionare. Ho fatto riferimento a Microsoft XML, v2.6 dll nel mio VBA, e quindi il seguente frammento di codice, mi fornisce i valori richiesti

 Dim objXML As MSXML2.DOMDocument Set objXML = New MSXML2.DOMDocument If Not objXML.loadXML(strXML) Then 'strXML is the string 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 

Aggiungi riferimento Progetto-> Riferimenti Microsoft XML, 6.0 ed è ansible utilizzare il codice di esempio:

  Dim xml As String 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 

fai attenzione al nodo xml // Root / Person non è uguale a // root / person, anche selectSingleNode (“Name”). text non è lo stesso con selectSingleNode (“name”). text

Questo è un parser OPML di esempio che funziona con i file opml di 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 String Dim attrLength As Byte Dim FilePath As String 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.Attributes.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 String Dim sAttrValue As String Dim attrLength As Byte Dim x As Long attrLength = curNode.Attributes.length For x = 0 To (attrLength - 1) sAttrName = curNode.Attributes.Item(x).nodeName sAttrValue = curNode.Attributes.Item(x).nodeValue Debug.Print sAttrName & " = " & sAttrValue Next Debug.Print "-----------" End Sub 

Questo prende alberi multilivello di cartelle (Awasu, NewzCrawler):

 ... Call xmldocOpen4 Call debugPrintOPML4(Null) ... Dim sText4 As String 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 String FilePath = "rss_awasu.opml" Set oFS = oFSO.OpenTextFile(CurrentProject.Path & "\" & FilePath) sText4 = oFS.ReadAll oFS.Close End Sub 

o meglio:

 Sub xmldocOpen4() Dim FilePath As String 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 

ma non capisco, perché xmldoc4 dovrebbe essere caricato ogni volta.

È ansible utilizzare una query XPath:

 Dim objDom As Object '// DOMDocument Dim xmlStr As String, _ xPath As String 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 

Ecco un breve sottotitolo per analizzare un file XML MicroStation Triforma che contiene dati per le forms strutturali in acciaio.

 'location of triforma structural files 'c:\programdata\bentley\workspace\triforma\tf_imperial\data\us.xml Sub ReadTriformaImperialData() Dim txtFileName As String Dim txtFileLine As String Dim txtFileNumber As Long Dim Shape As String Shape = "w12x40" txtFileNumber = FreeFile txtFileName = "c:\programdata\bentley\workspace\triforma\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 

Da qui puoi usare i valori per disegnare la forma in MicroStation 2d o farlo in 3d ed estruderlo in un solido.

Aggiornare

La procedura presentata di seguito fornisce un esempio di analisi XML con VBA utilizzando gli oggetti DOM XML. Il codice si basa su una guida per principianti del 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 – Questa risposta iniziale mostra la cosa più semplice che potessi immaginare (al momento stavo lavorando su un problema molto specifico). Naturalmente l’utilizzo delle funzionalità XML integrate nel VBA XML Dom sarebbe molto meglio. Vedi gli aggiornamenti sopra.

Risposta originale

So che questo è un post molto vecchio ma volevo condividere la mia semplice soluzione a questa domanda complicata. Principalmente ho usato le funzioni di base della stringa per accedere ai dati xml.

Ciò presuppone che tu abbia alcuni dati xml (nella variabile temp) che sono stati restituiti all’interno di una funzione VBA. È interessante notare che si può anche vedere come sto collegando a un servizio web xml per recuperare il valore. La funzione mostrata nell’immagine assume anche un valore di ricerca perché è ansible accedere a questa funzione VBA di Excel all’interno di una cella utilizzando = FunctionName (valore1, valore2) per restituire valori tramite il servizio Web in un foglio di calcolo.

funzione di esempio

 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)

Spesso è più semplice analizzare senza VBA, quando non si desidera abilitare i macro. Questo può essere fatto con la funzione di sostituzione. Inserisci i tuoi nodes iniziali e finali nelle celle B1 e 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,"") 

E la riga dei risultati E1 avrà il valore analizzato:

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