XML Fetch/Parse example

modMain.vbs

Option Explicit

Const API = "http://192.168.1.101/redmine/issues/"

Sub btnMain_Click()
    Dim i As Integer
    i = 2
    
    Do While Cells(i, 1) <> ""
        On Error GoTo 0
        
        Dim id As String
        id = Cells(i, 1)
        
        Dim issue As Object
        
        Set issue = GetXmlData(API + id + ".xml")
        
        On Error Resume Next
        
        Cells(i, 2) = issue.getElementsByTagName("tracker").Item(0).getAttribute("name")
        Cells(i, 3) = issue.getElementsByTagName("status").Item(0).getAttribute("name")
        Cells(i, 4) = issue.getElementsByTagName("priority").Item(0).getAttribute("name")
        Cells(i, 5) = issue.getElementsByTagName("subject").Item(0).text
        Cells(i, 6) = issue.getElementsByTagName("assigned_to").Item(0).getAttribute("name")
        
        i = i + 1
    Loop
End Sub

XmlLoader.vbs

Option Explicit

Public Function GetXmlData(url As String) As Object
    'http://msdn.microsoft.com/ja-jp/library/aa468547.aspx
    Dim dom As Object
    Set dom = CreateObject("MSXML2.DOMDocument")
    
    dom.async = False
    
    'http://support.microsoft.com/kb/281142/ja
    dom.setProperty "ServerHTTPRequest", True
 
    If Not (dom.Load(url)) Then
        Dim text As String
        With dom.parseError
            text = "XML Error encountered!" & vbCrLf & _
                "Error Code : " & .ErrorCode & vbCrLf & _
                "Error Reason : " & .reason & vbCrLf & _
                "Line # : " & .Line & vbCrLf & _
                "Line Position : " & .linepos & vbCrLf & _
                "File Position : " & .filepos & vbCrLf & _
                "Source Text : " & .srcText & vbCrLf & _
                "URL : " & .url
        End With
        MsgBox text, vbExclamation
        
        'Err.Raise dom.parseError.ErrorCode
        End 
    End If
    
    Set GetXmlData = dom.ChildNodes.Item(1)
End Function