vba를 사용하여 XML을 구문 분석하는 방법
나는 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 값을 두 개의 개별 정수 변수로 가져옵니다.
내가 일하는 분야로 인해 VB6 및 VBA에 갇혀 있기 때문에 XML에 관해서는 초보자입니다.
어떻게해야합니까?
이것은 약간 복잡한 질문이지만 가장 직접적인 경로는 XML 노드에 액세스 할 수있는 MSXML2.DOMDocument를 통해 XML 문서 또는 XML 문자열을로드하는 것 같습니다.
다음 사이트에서 MSXML2.DOMDocument에 대해 자세히 알아볼 수 있습니다.
- Excel VBA 및 Xpath로 XML 파일 조작
- MSXML-http: //msdn.microsoft.com/en-us/library/ms763742(VS.85).aspx
- MSXML 4.0 개요
포인터 주셔서 감사합니다.
이것이 문제에 대한 최선의 접근인지 아닌지는 모르겠지만, 어떻게 작동하는지 여기에 있습니다. VBA에서 Microsoft XML, v2.6 dll을 참조한 다음 다음 코드 조각을 통해 필요한 값을 제공합니다.
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
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
참조 Project-> References Microsoft 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 노드에주의하십시오. // Root / Person은 // root / person과 동일하지 않습니다. 또한 selectSingleNode ( "Name"). text는 selectSingleNode ( "name"). text와 동일하지 않습니다.
다음은 FeedDemon opml 파일로 작업하는 OPML 구문 분석기의 예입니다.
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가 매번로드되어야하는지 이해할 수 없습니다.
다음은 구조용 강철 모양에 대한 데이터가 포함 된 MicroStation Triforma XML 파일을 구문 분석하는 짧은 하위입니다.
'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
From here you can use the values to draw the shape in MicroStation 2d or do it in 3d and extrude it to a solid.
Update
The procedure presented below gives an example of parsing XML with VBA using the XML DOM objects. Code is based on a beginners guide of the 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 - This initial answer shows the simplest possible thing I could imagine (at the time I was working on a very specific issue) . Naturally using the XML facilities built into the VBA XML Dom would be much better. See the updates above.
Original Response
I know this is a very old post but I wanted to share my simple solution to this complicated question. Primarily I've used basic string functions to access the xml data.
This assumes you have some xml data (in the temp variable) that has been returned within a VBA function. Interestingly enough one can also see how I am linking to an xml web service to retrieve the value. The function shown in the image also takes a lookup value because this Excel VBA function can be accessed from within a cell using = FunctionName(value1, value2) to return values via the web service into a spreadsheet.
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)
Often it is easier to parse without VBA, when you don't want to enable macros. This can be done with the replace function. Enter your start and end nodes into cells B1 and 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,"")
And the result line E1 will have your parsed value:
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
참고URL : https://stackoverflow.com/questions/11305/how-to-parse-xml-using-vba
'programing tip' 카테고리의 다른 글
HTML SELECT-JavaScript를 사용하여 선택한 옵션을 VALUE로 변경 (0) | 2020.11.04 |
---|---|
Python에서 HTTP Get Web Request를 어떻게 보내나요? (0) | 2020.11.04 |
Xcode 5로 업데이트 한 후-ld : 아키텍처 armv7 또는 armv7s 링커 오류에 대한 기호를 찾을 수 없음 (0) | 2020.11.03 |
원격 서버에서 오류를 반환했습니다. (407) 프록시 인증 필요 (0) | 2020.11.03 |
Objective-C에서 두 배열을 어떻게 결합합니까? (0) | 2020.11.03 |