with - Cómo analizar XML utilizando vba

xml to excel vba

Question

Trabajo en VBA, y quiero analizar una cadena, por ejemplo

<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>

y obtenga los valores X e Y en dos variables enteras separadas.

Soy un novato cuando se trata de XML, ya que estoy atrapado en VB6 y VBA, debido al campo en el que trabajo.

¿Cómo hago esto?

Answer 1

A menudo es más fácil de analizar sin VBA, cuando no desea habilitar macros. Esto se puede hacer con la función de reemplazo. Ingrese sus nodos de inicio y final en las celdas B1 y 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,"")

Y la línea de resultado E1 tendrá su valor analizado:

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

Answer 2

Agregar proyecto de referencia-> Referencias Microsoft XML, 6.0 y puede usar código de ejemplo:

 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

tenga cuidado con el nodo xml // Root / Person no es lo mismo con // root / person, también selectSingleNode ("Name"). El texto no es igual con selectSingleNode ("name"). text

Answer 3

Aquí hay un subtítulo corto para analizar un archivo XML Triforma de MicroStation que contiene datos para formas de acero estructural.

''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

Desde aquí puede usar los valores para dibujar la forma en MicroStation 2d o hacerlo en 3d y extruirlo a un sólido.

Answer 4

Esta es una pregunta un poco complicada, pero parece que la ruta más directa sería cargar el documento XML o la cadena XML a través de MSXML2.DOMDocument, lo que le permitirá acceder a los nodos XML.

Puede encontrar más información en MSXML2.DOMDocument en los siguientes sitios:

• Manipulación de archivos XML con Excel VBA y Xpath
• MSXML - http://msdn.microsoft.com/en-us/library/ms763742(VS.85).aspx
• Una descripción general de MSXML 4.0

Answer 5

Este es un ejemplo de analizador OPML que trabaja con archivos opml de 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

Este toma árboles de carpetas de varios niveles (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 mejor:

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

pero no entiendo, por qué xmldoc4 debería cargarse cada vez.

Answer 6

Gracias por los consejos.

No sé si este es el mejor enfoque para el problema o no, pero aquí es cómo lo hice funcionar. Hice referencia al Microsoft XML, v2.6 dll en mi VBA, y luego el siguiente fragmento de código, me da los valores requeridos

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

Answer 7

Puede usar una consulta 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

Answer 8

Actualizar

El procedimiento presentado a continuación brinda un ejemplo de análisis de XML con VBA utilizando los objetos XML DOM. El código se basa en una guía para principiantes del XML DOM .

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 - Esta respuesta inicial muestra lo más simple posible que podría imaginarse (en ese momento estaba trabajando en un tema muy específico). Naturalmente, usar las instalaciones XML integradas en VBA XML Dom sería mucho mejor. Ver las actualizaciones de arriba.

Respuesta original

Sé que esta es una publicación muy antigua, pero quería compartir mi solución simple a esta complicada pregunta. Principalmente he usado funciones básicas de cadena para acceder a los datos xml.

Esto supone que tiene algunos datos xml (en la variable de temperatura) que se han devuelto dentro de una función de VBA. Curiosamente, uno también puede ver cómo me estoy vinculando a un servicio web xml para recuperar el valor. La función que se muestra en la imagen también toma un valor de búsqueda porque se puede acceder a esta función de Excel VBA desde una celda usando = FunctionName (value1, value2) para devolver valores a través del servicio web en una hoja de cálculo.

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)