vba를 사용하여 XML을 구문 분석하는 방법

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에 관한 한 초보입니다.

이거 어떻게 해요?

조언 감사합니다.

이것이 문제에 대한 최선의 접근인지 아닌지는 모르겠지만, 제가 어떻게 해결했는지는 이렇습니다.나는 내 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

이것은 약간 복잡한 질문이지만, 가장 직접적인 경로는 MSXML2를 통해 XML 문서 또는 XML 문자열을 로드하는 것이 될 것으로 보입니다.그러면 XML 노드에 액세스할 수 있는 DOM 문서.

MSXML2에서 더 많은 정보를 찾을 수 있습니다.다음 사이트의 DOM 문서:

• Excel VBA 및 Xpath로 XML 파일 조작
• MSXML - http://msdn.microsoft.com/en-us/library/ms763742(VS.85).aspx
• MSXML 4.0 개요

참조 프로젝트 추가 ->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과 같지 않도록 주의하십시오. 또한 SingleNode("이름")를 선택하십시오.텍스트가 selectSingleNode("name") 텍스트와 같지 않습니다.

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

다음은 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를 실어야 하는지 이해가 안 됩니다.

갱신하다

아래에 제시된 절차는 XML DOM 개체를 사용하여 VBA로 XML을 구문 분석하는 예를 제공합니다.코드는 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 - 이 초기 답변은 제가 상상할 수 있는 가장 간단한 것을 보여줍니다(당시 매우 특정한 문제에 대해 작업하고 있었습니다). 당연히 VBA XML 돔에 내장된 XML 기능을 사용하는 것이 훨씬 더 나을 것입니다.위의 업데이트 내용을 참조하십시오.

원 응답

이것이 아주 오래된 게시물이라는 것을 알지만 이 복잡한 질문에 대한 간단한 해결책을 공유하고 싶었습니다.주로 저는 xml 데이터에 접근하기 위해 기본 문자열 함수를 사용했습니다.

이것은 VBA 함수 내에서 반환된 일부 xml 데이터(temp 변수)가 있다고 가정합니다.흥미롭게도 제가 xml 웹 서비스에 링크하여 값을 검색하는 방법도 볼 수 있습니다.이 Excel VBA 기능은 = FunctionName(value1, value2)을 사용하여 셀 내에서 액세스하여 웹 서비스를 통해 값을 스프레드시트로 반환할 수 있기 때문에 이미지에 표시된 기능도 조회 값을 사용합니다.

openTag = ""
closeTag = "" 

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

다음은 구조용 강철 형상에 대한 데이터를 포함하는 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

여기서 값을 사용하여 MicroStation 2d에서 모양을 그리거나 3d에서 수행하여 고체로 압출할 수 있습니다.

매크로를 사용하도록 설정하지 않을 때 VBA 없이 구문 분석하는 것이 더 쉬운 경우가 많습니다.이것은 교체 기능으로 할 수 있습니다.셀 B1과 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,"")

그리고 결과선 E1은 파싱된 값을 갖게 됩니다.

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