xml - vba を使用して XML を解析する方法

Question

私は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の値を2つの別々の整数変数に取得します。

私は XML に関しては初心者です。なぜなら、私が働いている分野のために VB6 と VBA に行き詰まっているからです。

どうすればいいですか？

score 79 · Accepted Answer

ポインタをありがとう。

これが問題に対する最善のアプローチであるかどうかはわかりませんが、これがどのように機能するかです。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

score 56 · Accepted Answer

これは少し複雑な質問ですが、MSXML2.DOMDocument を介して XML ドキュメントまたは XML 文字列をロードし、XML ノードにアクセスできるようにするのが最も直接的な方法のようです。

MSXML2.DOMDocument の詳細については、次のサイトを参照してください。

score 19 · Accepted Answer

参照 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 と同じではありません

score 17 · Accepted Answer

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

score 9 · Accepted Answer

これは、FeedDemonopmlファイルを操作する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を毎回ロードする必要があるのかわかりません。

score 3 · Accepted Answer

アップデート

以下に示す手順は、XMLDOMオブジェクトを使用してVBAでXMLを解析する例を示しています。コードは、 XMLDOMの初心者ガイドに基づいています。

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-この最初の答えは、私が想像できる最も単純なことを示しています（私が非常に特定の問題に取り組んでいたとき）。当然、VBAXMLDomに組み込まれているXML機能を使用する方がはるかに優れています。上記の更新を参照してください。

元の応答

これは非常に古い投稿であることは知っていますが、この複雑な質問に対する私の簡単な解決策を共有したいと思いました。主に、基本的な文字列関数を使用してxmlデータにアクセスしました。

これは、VBA関数内で返されたxmlデータ（一時変数内）があることを前提としています。興味深いことに、値を取得するためにxmlWebサービスにリンクしている方法もわかります。このExcelVBA関数は、セル内から= FunctionName（value1、value2）を使用してアクセスし、Webサービスを介してスプレッドシートに値を返すことができるため、画像に示されている関数もルックアップ値を取ります。

サンプル関数


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)

score 2 · Accepted Answer

以下は、構造用鋼形状のデータを含む 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 で描画してソリッドに押し出すことができます。

score 0 · Accepted Answer

マクロを有効にしたくない場合は、多くの場合、VBA を使用しない方が簡単に解析できます。これは、replace 関数を使用して行うことができます。開始ノードと終了ノードをセル 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

xml - vba を使用して XML を解析する方法

8 に答える 8

Related

Reference