Pertanyaan Cara mengurai XML menggunakan vba


Saya bekerja di VBA, dan ingin menguraikan string misalnya

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

dan dapatkan nilai X & Y menjadi dua variabel integer terpisah.

Saya seorang pemula ketika datang ke XML, karena saya terjebak di VB6 dan VBA, karena bidang tempat saya bekerja.

Bagaimana saya melakukan ini?


63
2017-08-14 16:41


asal


Jawaban:


Ini adalah sedikit pertanyaan yang rumit, tetapi sepertinya rute yang paling langsung adalah memuat dokumen XML atau string XML melalui MSXML2.DOMDocument yang kemudian akan memungkinkan Anda mengakses node XML.

Anda dapat menemukan lebih banyak di MSXML2.DOMDocument di situs-situs berikut:


49
2017-08-14 16:47



Terima kasih atas petunjuknya.

Saya tidak tahu, apakah ini adalah pendekatan terbaik untuk masalah atau tidak, tetapi di sini adalah bagaimana saya membuatnya bekerja. Saya mereferensikan Microsoft XML, v2.6 dll di VBA saya, dan kemudian potongan kode berikut, memberi saya nilai yang diperlukan

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

67
2017-08-14 17:40



Tambahkan referensi Project-> Referensi Microsoft XML, 6.0 dan Anda dapat menggunakan kode contoh:

    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 

hati-hati dengan xml node // Root / Person tidak sama dengan // root / person, juga selectSingleNode ("Name"). teks tidak sama dengan selectSingleNode ("name"). teks


9
2017-10-13 13:29



Ini adalah contoh OPML parser yang bekerja dengan file-file opos 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

Yang ini mengambil banyak folder folder (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

atau lebih baik:

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

tetapi saya tidak mengerti, mengapa xmldoc4 harus dimuat setiap kali.


7
2018-05-09 02:19



Anda bisa menggunakan XPath Query:

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

7
2017-12-30 11:24



Berikut ini adalah sub singkat untuk menguraikan file XML Trifiks MicroStation yang berisi data untuk bentuk-bentuk baja struktural.

'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

Dari sini Anda dapat menggunakan nilai-nilai untuk menggambar bentuk di MicroStation 2d atau melakukannya dalam 3d dan mengusirnya ke solid.


2
2018-01-12 18:30



Memperbarui

Prosedur yang disajikan di bawah ini memberikan contoh parsing XML dengan VBA menggunakan objek XML DOM. Kode didasarkan pada panduan pemula dari DOM 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

Nota bene - Jawaban awal ini menunjukkan hal paling sederhana yang dapat saya bayangkan (pada saat saya mengerjakan masalah yang sangat spesifik).   Tentu menggunakan fasilitas XML yang dibangun ke dalam VBA XML Dom   jauh lebih baik. Lihat pembaruan di atas.

Tanggapan Asli

Saya tahu ini adalah posting yang sangat lama tetapi saya ingin berbagi solusi sederhana saya untuk pertanyaan rumit ini. Terutama saya telah menggunakan fungsi string dasar untuk mengakses data xml.

Ini mengasumsikan Anda memiliki beberapa data xml (dalam variabel temp) yang telah dikembalikan dalam fungsi VBA. Yang cukup menarik juga dapat melihat bagaimana saya menghubungkan ke layanan web xml untuk mengambil nilai. Fungsi yang ditunjukkan dalam gambar juga mengambil nilai pencarian karena fungsi Excel VBA ini dapat diakses dari dalam sel menggunakan = FunctionName (value1, value2) untuk mengembalikan nilai melalui layanan web ke dalam spreadsheet.

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)


0
2018-04-21 16:30



Seringkali lebih mudah mengurai tanpa VBA, ketika Anda tidak ingin mengaktifkan makro. Ini bisa dilakukan dengan mengganti fungsi. Masukkan simpul awal dan akhir Anda ke dalam sel B1 dan 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,"")

Dan garis hasil E1 akan memiliki nilai parsing Anda:

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

0
2017-11-30 22:13