XML Fetch/Parse example
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
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