Разбор строки xml в VBA

Question

Я пытаюсь разобрать XML-документ, который я получаю с веб-сайта. по какой-то причине я не могу вычислить, что я не могу проанализировать значение внутри узла «RATE». Строка xml кажется O.K. , но в конце кода (прокомментировано) я получаю переменную Object или с переменной блока не установлена ​​ошибка. Буду благодарен за любую помощь.

XML STRING:

<?xml version="1.0" encoding="utf-8" standalone="yes"?> 
<CURRENCIES> 
    <LAST_UPDATE>2016-01-25</LAST_UPDATE> 
    <CURRENCY> 
    <NAME>Dollar</NAME> 
    <UNIT>1</UNIT> 
    <CURRENCYCODE>USD</CURRENCYCODE> 
    <COUNTRY>USA</COUNTRY> 
    <RATE>3.982</RATE> 
    <CHANGE>0.277</CHANGE> 
    </CURRENCY> 
</CURRENCIES> 

VBA КОД:

Private Sub loadXMLString(xmlString) 

    Dim strXML As String 
    Dim xNode As IXMLDOMNode 
    Dim XDoc As MSXML2.DOMDocument 

    strXML = xmlString 

    Set XDoc = New MSXML2.DOMDocument 

    If Not XDoc.LoadXML(strXML) Then 'strXML is the string with XML' 
     Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason 
    End If 

    Set xNode = XDoc.FirstChild 

    Debug.Print xNode.SelectSingleNode("RATE").Text ' here i get the Object variable or With block variable not set error 
    Debug.Print xNode.ChildNodes(2).SelectSingleNode("RATE").Text ' also with that try i get the Object variable or With block variable not set error 

End Sub 

UPDATE: я нашел проблему (как я записал в комментариях к @ Натан). проблема является <?xml version="1.0" encoding="utf-8" standalone="yes"?> узел

Испытано ему этот код работает: так, как я могу это сделать с, чтобы удалить этот узел в качестве подстроки, должно быть так, как я думаю, но я не имею большой опыт работы с XML

Private Sub loadXMLString(xmlString) 

    Dim strXML As String 
    Dim xNode As IXMLDOMNode 
    Dim XDoc As MSXML2.DOMDocument 

    strXML = "<CURRENCIES>" & _ 
    "<LAST_UPDATE>2016-01-25</LAST_UPDATE>" & _ 
    "<CURRENCY>" & _ 
    "<NAME>Dollar</NAME>" & _ 
    "<UNIT>1</UNIT>" & _ 
    "<CURRENCYCODE>USD</CURRENCYCODE>" & _ 
    "<COUNTRY>USA</COUNTRY>" & _ 
    "<RATE>3.982</RATE>" & _ 
    "<CHANGE>0.277</CHANGE>" & _ 
    "</CURRENCY>" & _ 
"</CURRENCIES>" 

    Set XDoc = New MSXML2.DOMDocument 

    If Not XDoc.LoadXML(strXML) Then 'strXML is the string with XML' 
     Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason 
    End If 

    Set xNode = XDoc.FirstChild 

    Debug.Print strXML 

    Debug.Print xNode.ChildNodes(1).SelectSingleNode("RATE").Text ' also with that try i get the Object variable or With block variable not set error 

End Sub 

Answer 1

SelectSingleNode() ожидает выражение XPath. Попробуйте это:

xNode.SelectSingleNode("//RATE").Text 

Но в целом это не очень умно, чтобы доступ к свойствам ссылки на объект, который может быть Nothing - как это в приведенном выше случае, если SelectSingleNode не находит соответствующий узел, эта строка будет вызвать ошибку времени выполнения (. «переменная объекта или переменная блока не установлена», который фактически является нулевым исключением указателя)

Всегда берегите имущество обращается путем проверки вашей ссылки на объект:

Set rate = xNode.SelectSingleNode("//RATE") 

If rate Is Nothing Then 
    Debug.Print "Error: no RATE found in document" 
Else 
    Debug.Print rate.Text 
End If 

---

FWIW, вот полная версия кода, который я использовал бы, показывая несколько приятных деталей, как пользовательский тип для информации валюты и использовать функцию Sleep() ждать сервера, чтобы вернуть документ XML:

Option Explicit 

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

Public Type CurrencyInfo 
    Success As Boolean 
    LastUpdate As Date 
    Name As String 
    Unit As Double 
    CurrencyCode As String 
    Country As String 
    Rate As Double 
    Change As Double 
End Type 

Private Function GetXmlDoc(url As String) As MSXML2.DOMDocument60 
    With New MSXML2.XMLHTTP60 
     .Open "GET", url, False 
     .send 
     While .readyState <> 4: Sleep 50: Wend 
     If .Status = 200 Then 
      If .responseXML.parseError.ErrorCode = 0 Then 
       Set GetXmlDoc = .responseXML 
      Else 
       Err.Raise vbObjectError + 1, "GetXmlDoc", "XML parser error: " & .responseXML.parseError.reason 
      End If 
     Else 
      Err.Raise vbObjectError + 2, "GetXmlDoc", "Server responded with status code " & .Status 
     End If 
    End With 
End Function 

Public Function GetCurrencyInfo(currencyName As String) As CurrencyInfo 
    Dim curr As MSXML2.DOMDocument60 
    Set curr = GetXmlDoc("http://the/url/you/use?currency=" + currencyName) 

    GetCurrencyInfo.Success = True 
    GetCurrencyInfo.LastUpdate = CDate(GetText(curr, "//LAST_UPDATE")) 
    GetCurrencyInfo.Name = GetText(curr, "//NAME") 
    GetCurrencyInfo.Unit = Val(GetText(curr, "//UNIT")) 
    GetCurrencyInfo.CurrencyCode = GetText(curr, "//CURRENCYCODE") 
    GetCurrencyInfo.Country = GetText(curr, "//COUNTRY") 
    GetCurrencyInfo.Rate = Val(GetText(curr, "//RATE")) 
    GetCurrencyInfo.Change = Val(GetText(curr, "//CHANGE")) 
End Function 

Private Function GetText(context As IXMLDOMNode, path As String) As String 
    Dim result As IXMLDOMNode 
    If Not context Is Nothing Then 
     Set result = context.SelectSingleNode(path) 
     If Not result Is Nothing Then GetText = result.Text 
    End If 
End Function 

Использование выглядит следующим образом:

Sub Test() 
    Dim USD As CurrencyInfo 
    USD = GetCurrencyInfo("USD") 

    Debug.Print "LastUpdate: " & USD.LastUpdate 
    Debug.Print "Name: " & USD.Name 
    Debug.Print "Unit: " & USD.Unit 
    Debug.Print "CurrencyCode: " & USD.CurrencyCode 
    Debug.Print "Country: " & USD.Country 
    Debug.Print "Rate: " & USD.Rate 
    Debug.Print "Change: " & USD.Change 
End Sub 

Answer 2

Пробовал это, и получил Somwhere.

 Dim strXML As String 
Dim xNode As IXMLDOMNode 
Dim XDoc As MSXML2.DOMDocument 
Dim xParent As IXMLDOMNode 
Dim xChild As MSXML2.IXMLDOMNode 

strXML = xmlString 

Set XDoc = New MSXML2.DOMDocument 

If Not XDoc.Load(strXML) Then 'strXML is the string with XML' 
    Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason 
End If 

Set xNode = XDoc.DocumentElement 
Set xParent = xNode.FirstChild 

For Each xParent In xNode.ChildNodes 
    For Each xChild In xParent.ChildNodes 
     Debug.Print xChild.Text 
    Next xChild 
Next xParent