GDIplusCODE


'********************************************************************
'
' Default NameSpaceつきのXMLにXPATHを用いる
'
'********************************************************************

'Microsoftのサンプルxmlを改造し、デフォルトネームスペースを付与したもの
'<?xml version="1.0"?>
'<main xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns="https://msdn.microsoft.com/ja-jp/library/ms762271" >
'<!--- https://msdn.microsoft.com/ja-jp/library/ms762271(v=vs.85).aspx -->
'<catalog>
'   <book id="bk101">
'   </book>
'     略
'   <book id="bk102">
'     略
'   </book>
'    <book id="bk103">
'         <author>Corets, Eva</author>
'         <title>Maeve Ascendant</title>
'         <genre>Fantasy</genre>
'         <price>5.95</price>
'         <publish_date>2000-11-17</publish_date>
'         略
'      </book>
'   以下、複数個
'</catalog>
'</main>

'MSのサンプコードルをみると、全てにMSXML2を付けていた
'これを付けないと古いオブジェクトになるとの事だが、
'つけてみても、当方の困っている現象は解消されなかった...

Sub read_XML()
    Dim oXMLDom As New MSXML2.DOMDocument60
    Dim myElement As MSXML2.IXMLDOMElement
    Dim myNodes As MSXML2.IXMLDOMNodeList
    
    Dim strFILEPATH As String
    Dim rtResult As Variant
    
    With oXMLDom
      .async = False
      .validateOnParse = False
      .resolveExternals = False
      .preserveWhiteSpace = False  'Falseにして空ノードを相手にしない
      'Default NamespaceおよびそのAliasの指定
      'このAliasを、Tagに全て付けてXPATHを指定する必要がある。
      .setProperty "SelectionNamespaces", "xmlns:dns='https://msdn.microsoft.com/ja-jp/library/ms762271'"
      .setProperty "SelectionLanguage", "XPath"
    End With
   
    strFILEPATH = GetDesktopPath & "\ms_sample.xml"
    rtResult = oXMLDom.Load(strFILEPATH)
    
    If rtResult = False Then
      MsgBox "XML読込に失敗しました"
      Exit Sub
    End If
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book")
    Debug.Print myNodes.Length  '12
    'Attributeの値を指定して取得
    Set myElement = oXMLDom.SelectSingleNode("dns:main/dns:catalog/dns:book[@id='bk103']/dns:title")
    Debug.Print myElement.Text  'Maeve Ascendant
    'Nodeの値を指定して取得
    Set myElement = oXMLDom.SelectSingleNode("dns:main/dns:catalog/dns:book[dns:title='Maeve Ascendant']")
    Debug.Print myElement.Attributes.getNamedItem("id").Text  'bk103
    '相対指定
    Set myElement = myElement.SelectSingleNode("dns:title")
    Debug.Print myElement.Text  'Maeve Ascendant
    'following-siblingは単体では機能しないらしい
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book[dns:title='Maeve Ascendant']/dns:title/following-sibling")
    Debug.Print myNodes.Length '0
    '下記ならOK
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book[dns:title='Maeve Ascendant']/dns:title/following-sibling::*")
    Debug.Print myNodes.Length '4
    '書籍名を指定して、価格を取得してみた
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book[dns:title='Maeve Ascendant']/dns:title/following-sibling::dns:price")
    Debug.Print myNodes.Item(0).Text '5.95
    '下記でもOK
    Set myElement = oXMLDom.SelectSingleNode("dns:main/dns:catalog/dns:book[dns:title='Maeve Ascendant']/dns:title/following-sibling::dns:price")
    Debug.Print myElement.Text '5.95
    '下記の方がストレートと思うが、 意図せず、最初のbookノードのpriceを返してくる。
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book/dns:title['Maeve Ascendant']/following-sibling::dns:price")
    Debug.Print myNodes.Item(0).Text '44.95
    Debug.Print myNodes.Length '12 []内の指定が無効の様だ
    '下記ならOK
    Set myNodes = oXMLDom.SelectNodes("dns:main/dns:catalog/dns:book/dns:title[text()='Maeve Ascendant']/following-sibling::dns:price")
    Debug.Print myNodes.Item(0).Text '5.95
    Debug.Print myNodes.Length '1
    
    Set oXMLDom = Nothing
    
End Sub

Private Function GetDesktopPath() As String
  Dim wScriptHost As Object, strInitDir As String
  Set wScriptHost = CreateObject("Wscript.Shell")
  GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
  Set wScriptHost = Nothing
End Function<
Default NamespaceのあるXMLでXPATHを使う
