Come analizzare XML utilizzando vba
-
08-06-2019 - |
Domanda
Lavoro in VBA e voglio analizzare una stringa, ad es
<PointN xsi:type='typens:PointN'
xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'
xmlns:xs='http://www.w3.org/2001/XMLSchema'>
<X>24.365</X>
<Y>78.63</Y>
</PointN>
e ottieni i valori X e Y in due variabili intere separate.
Sono un principiante quando si tratta di XML, poiché sono bloccato in VB6 e VBA, a causa del campo in cui lavoro.
Come faccio a fare questo?
Soluzione
Questa è una domanda un po' complicata, ma sembra che il percorso più diretto sia caricare il documento XML o la stringa XML tramite MSXML2.DOMDocument che consentirà quindi di accedere ai nodi XML.
È possibile trovare ulteriori informazioni su MSXML2.DOMDocument nei seguenti siti:
Altri suggerimenti
Grazie per le indicazioni
Non so se questo sia l'approccio migliore al problema o meno, ma ecco come ho fatto a farlo funzionare.Ho fatto riferimento a Microsoft XML, dll v2.6 nel mio VBA, 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 il riferimento Progetto->Riferimenti Microsoft XML, 6.0 e puoi utilizzare il codice di esempio:
Dim xml As String
xml = "<root><person><name>Me </name> </person> <person> <name>No Name </name></person></root> "
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 con il nodo xml //Root/Person non è lo stesso con //root/person, inoltre selectSingleNode("Name").text non è lo stesso con selectSingleNode("name").text
Puoi utilizzare una query XPath:
Dim objDom As Object '// DOMDocument
Dim xmlStr As String, _
xPath As String
xmlStr = _
"<PointN xsi:type='typens:PointN' " & _
"xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " & _
"xmlns:xs='http://www.w3.org/2001/XMLSchema'> " & _
" <X>24.365</X> " & _
" <Y>78.63</Y> " & _
"</PointN>"
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
Questo è un esempio di parser OPML 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 richiede alberi di cartelle multilivello (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.
Ecco un breve sottotitolo per analizzare un file XML MicroStation Triforma che contiene dati per forme 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 utilizzare i valori per disegnare la forma in MicroStation 2d o farlo in 3d ed estruderlo in un solido.
Aggiornamento
La procedura presentata di seguito fornisce un esempio di analisi XML con VBA utilizzando gli oggetti DOM XML.Il codice si basa su a 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 possibile che potessi immaginare (all'epoca stavo lavorando su un problema molto specifico).L'uso naturale delle strutture XML integrate nel DOM VBA XML 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 utilizzato funzioni stringa di base per accedere ai dati xml.
Ciò presuppone che tu abbia alcuni dati xml (nella variabile temporanea) che sono stati restituiti all'interno di una funzione VBA.È interessante notare che si può anche vedere come mi sto collegando a un servizio Web xml per recuperare il valore.La funzione mostrata nell'immagine accetta anche un valore di ricerca perché è possibile accedere a questa funzione VBA di Excel dall'interno di una cella utilizzando = FunctionName(value1, value2) per restituire valori tramite il servizio Web in un foglio di calcolo.
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 eseguire l'analisi senza VBA, quando non si desidera abilitare le macro.Questo può essere fatto con la funzione di sostituzione.Inserisci i nodi iniziale e finale nelle celle B1 e C1.
Cell A1: {your XML here}
Cell B1: <X>
Cell C1: </X>
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 del risultato E1 avrà il tuo valore analizzato:
Cell A1: {your XML here}
Cell B1: <X>
Cell C1: </X>
Cell D1: 24.365<X><Y>78.68</Y></PointN>
Cell E1: 24.365