Saya bekerja di VBA, dan ingin mengurai 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 harga X & Y nilai-nilai ke dua variabel integer.
I'm newbie ketika datang ke XML, karena saya'm terjebak di VB6 dan VBA, karena bidang saya bekerja di.
Bagaimana saya melakukan ini?
Terima kasih untuk petunjuk.
Saya don't tahu, apakah ini adalah pendekatan yang terbaik untuk masalah ini atau tidak, tapi di sini adalah bagaimana saya mendapatkannya untuk bekerja. Saya direferensikan Microsoft XML, v2.6 dll di VBA, dan kemudian potongan kode berikut, memberi saya nilai-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
Ini adalah sedikit rumit, tapi sepertinya rute yang paling langsung akan memuat dokumen XML atau XML string melalui MSXML2.DOMDocument yang kemudian akan memungkinkan anda untuk mengakses node XML.
Anda dapat menemukan lebih banyak tentang MSXML2.DOMDocument di situs-situs berikut:
Anda dapat menggunakan 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
Tambahkan referensi Proyek->Referensi Microsoft XML, 6.0 dan anda dapat menggunakan contoh kode:
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/Orang adalah tidak sama dengan //root/orang, juga selectSingleNode("").teks tidak sama dengan selectSingleNode("").teks
Ini adalah contoh OPML parser bekerja dengan FeedDemon file 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
Yang satu ini membutuhkan bertingkat pohon 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
tapi aku don't mengerti, mengapa xmldoc4 harus diambil setiap waktu.
Update
Prosedur yang disajikan di bawah ini memberikan contoh parsing XML dengan menggunakan VBA XML DOM benda-benda. Kode didasarkan pada panduan pemula 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 - awal Ini jawaban menunjukkan yang paling sederhana mungkin hal yang bisa saya bayangkan (pada saat saya bekerja pada sebuah masalah yang sangat spesifik) . secara Alami menggunakan XML fasilitas yang dibangun ke dalam VBA XML Dom akan jauh lebih baik. Lihat update di atas.
Original Respon
Aku tahu ini adalah waktu yang sangat lama posting tapi saya ingin berbagi solusi sederhana untuk ini pertanyaan rumit. Terutama saya've digunakan dasar string fungsi untuk mengakses data xml.
Ini mengasumsikan anda memiliki beberapa data xml (dalam variabel temp) yang telah kembali dalam fungsi VBA. Menariknya, kita juga dapat melihat bagaimana saya menghubungkan ke layanan web xml untuk mengambil nilai. Fungsi yang ditampilkan pada gambar juga membutuhkan lookup value karena ini Excel VBA fungsi dapat diakses dari dalam sel dengan menggunakan = FunctionName(value1, value2) untuk mengembalikan nilai-nilai melalui layanan web ke spreadsheet.
openTag = "<" & tagValue & ">"
closeTag = "< /" & tagValue & ">"
' Menemukan posisi melampirkan tag
startPos = InStr(1, temp, openTag)
endPos = InStr(1, temp, closeTag)
startTagPos = InStr(startPos, temp, ">") + 1
' Parse xml untuk mengembalikan nilai
Data = Mid(temp, startTagPos, endPos - startTagPos)
Berikut ini beberapa sub untuk mengurai MicroStation Triforma file XML yang berisi data untuk 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 3d dan mengusir ke padat.
Sering lebih mudah untuk mengurai tanpa VBA, ketika anda don't ingin mengaktifkan macro. Hal ini dapat dilakukan dengan mengganti fungsi. Masukkan awal dan akhir node 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 hasilnya garis E1 akan memiliki nilai terurai:
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