Я работаю в VBA и хочу разобрать строку, например
<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>
и получить значения X & Y в две отдельные целочисленные переменные.
Я новичок, когда дело доходит до XML, так как я застрял в VB6 и VBA, из-за области, в которой я работаю.
Как мне это сделать?
Спасибо за подсказки.
Я не знаю, лучший ли это подход к проблеме или нет, но вот как я заставил его работать. Я сослался на Microsoft XML, v2.6 dll в своем VBA, а затем следующий фрагмент кода дал мне необходимые значения
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
Это немного сложный вопрос, но кажется, что самым прямым путем будет загрузка XML документа или XML строки через MSXML2.DOMDocument, который затем позволит вам получить доступ к XML узлам.
Подробнее о MSXML2.DOMDocument можно узнать на следующих сайтах:
Вы можете использовать запрос 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
Добавить ссылку на проект->ссылки XML Майкрософт, 6.0 и вы можете примеру использовать код:
в
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
будьте осторожны с узлом XML //корень/лица не ///корень человека, также метод selectsinglenode("с именем").текст-это не метод selectsinglenode("с именем").текст
Это пример OPML парсера, работающего с opml файлами 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
Этот принимает многоуровневые деревья папок (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
или лучше:
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
но я не понимаю, почему xmldoc4 должен загружаться каждый раз.
Обновление
Процедура, представленная ниже, дает пример парсинга XML-файле с помощью VBA с использованием объектов XML дом. Код основан на руководство для начинающих в 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
Нота Бене - этот первоначальный ответ показана самая простая вещь, которую я мог себе представить (на тот момент я работал на вполне конкретный вопрос) . естественно с использованием XML-объектов, построенных в XML ВБА дом будет гораздо лучше. См. выше обновления.
Оригинальный Ответ
Я знаю, что это очень старый пост, но я хотел бы поделиться мое простое решение этого сложного вопроса. В первую очередь я'вэ использовать базовые строковые функции для доступа к XML-данным.
При этом предполагается, что некоторые XML-данных (в переменной Temp), который был возвращен в функцию VBA. Любопытно также можно увидеть, как я ссылка на веб-службу XML, чтобы получить значение. Функция, показанная на рисунке также происходит поиск значения, потому что эта функция на VBA в Excel может осуществляться в камере с помощью = Имя_функции(значение1, значение2) для возврата значений через web-сервис в таблицу.
в <предварительно><код> openTag = " и<" и &АМП; tagValue &ампер; на ">"и closeTag = " и< /" и &АМП; tagValue &ампер; на ">" и <БР>' найти положение вшита теги startPos = функция instr(1, ТЭМП openTag) endPos = функция instr(1, ТЭМП closeTag) startTagPos = инстр(startPos, ТЭМП " и> наша") + 1 ' синтаксический анализ XML для возвращаемого значения Данные = середина(темп startTagPos, endPos - startTagPos) </пре></код>
Вот краткий суб разобрать XML-файл в MicroStation Triforma, который содержит данные для строительных стальных форм.
в
'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
Отсюда вы можете использовать значения, чтобы нарисовать фигуру в MicroStation 2D или сделать его в 3D и вытянуть его до твердого.
Часто это легче разобрать без VBA, когда вы Don'т хотите, чтобы включить макросы. Это можно сделать при помощи функции заменить. Введите начальную и конечные узлы в ячейки В1 и С1.
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,"")
И результат Е1 будет иметь свой анализируется значение:
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