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

https://stackoverflow.com/questions/11305

08-06-2019
|

문제

서 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 기 때문에,의 분야 내에서 작동 합니다.

어떻게 해야 하나요?

해결책

이것은 약간의 복잡한 문제이지만,그것은 것이 가장 좋아하는 직접적인 경로를 것을 로드하는 XML 문서 또는 XML 문자열을 통해 MSXML2.DOMDocument 수 있도록 다음 당신은에 액세스하는 XML 노드입니다.

할 수 있습에 대한 자세한 내용을 확인 MSXML2.DOMDocument 에서는 다음 사이트:

다른 팁

감사에 대한 포인터입니다.

모르겠는지 여부,이 문제에 접근하거나지 않지만,여기에 제가 어떻게 여기까지 왔는지 그것을 작동합니다.내가 참조 Microsoft XML,v2.6dll 내 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

추가 프로젝트 참조->참조 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/사람이 동일하지 않//root/person,또한 selectSingleNode("Name").텍스트와 같은 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

이것은 예 OPML 파서 작업 FeedDemon 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 해야로드됩니다.

여기에는 짧은 하위 분석하는 마이크로 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

여기에서 당신은 값을 사용할 수 있습을 그릴 모양에서 마이크로 2d 또는 3d 고 돌출을 견고하다.

업데이트

제시된 절차는 아래의 예를 제공합 XML 구문 분석 VBA 를 사용하는 XML DOM 개체입니다.코드를 기반으로 초보자 가이드 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 -이 초기 응답여 가장 간단한 가능한 것은 내가 상상할 수 있(시에 나는 작업에서 매우 특별한 문제가 있습니다.)자연적으로 사용하는 XML 시설 내장 VBA XML Dom 것 훨씬 낫다.업데이트를 볼 수 있다.

원본 응답

내가 이것을 알고 있는 것은 아주 오래된 게시물을 공유하는 간단한 솔루션이 복잡해 질문입니다.주로 사용은 기본 문자열은 기능을 xml 데이터에 액세스.

이것은 추측이 있는 xml 데이터(온도 변수)반환된 내 VBA 기능입니다.충분히 흥미롭게 한 또한 볼 수 있습니다 내가 어떻게 연결하는 xml 웹 서비스를 검색하는 값입니다.이 기능은 이미지에 표시도 조회 가치가 있기 때문에 이 Excel VBA 기능에서 액세스할 수 있을 사용하여 셀=붙(value1,값 2)값을 반환을 통해 웹 서비스로 스프레드시트에서도 합니다.

sample function


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)

그것은 종종 쉽게 분석하고 없이 VBA,고 싶지 않을 때 사용됩니다.이와 함께 할 수 있는 기능을 대체합니다.입력하신의 시작과 끝 노드로 세포 B1C1.

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

라이센스 : CC-BY-SA ~와 함께 속성

제휴하지 않습니다 StackOverflow