API Help Needed

[nymets05]

Hi everyone,
I am working on my first code and I am trying to scrape data from the Federal Reserve.


Here is my code:



Sub CivilianUnemployment()

Dim wx As Worksheet: Set ws = Worksheets("API")

Dim strURL As String
strURL = ws.[FRED]

Dim hReq As New WinHttpRequest
hReq.Open "GET", strURL, False
hReq.Send

Dim strReq As String
strResp = hReq.ResponseText

Dim xmlDoc As New MSXML2.DOMDocument60
If Not xmlDoc.LoadXML(strResp) Then
MsgBox "Load error"
End If

Dim xnodelist As MSXML2.IXMLDOMNodeList
Set xnodelist = xmlDoc.getElementsByTagName("observations")

Dim xnode As MSXML2.IXMLDOMNode
Set xnode = xnodelist.Item(0)

Dim obAtt1 As MSXML2.IXMLDOMAttribute
Dim obAtt2 As MSXML2.IXMLDOMAttribute

Dim xChild As MSXML2.IXMLDOMNode

Dim intRow As Integer
intRow = 2

Dim strCol1 As String
strCol1 = "A"
Dim strCol2 As String
strCol2 = "B"

Dim dtVal As Date
Dim dblRate As Double
Dim strVal As String

Set hReq = Nothing
Set xmlDoc = Nothing

End Sub


No error messages show up, but when I run the program, nothing happens. If I could get any help for this that would be great. Thank you

[SamT]

The only noticeable thing your code does is check to see if xmlDoc.LoadXML(strResp) failed. If it doesn't fail, the code does nothing.

In fact after that one test, nothing else at all happens. You can literally delete every line of code after "end If" without affecting the code's workings.

[snb]

Apply an Excel querytable

[offthelip]

the code that I ususally start with for doing webscraping is this, which I then modify to extract just that data I am looking for on that website.


Sub webscrape()
With Worksheets("sheet1")
Range(.Cells(1, 1), .Cells(5000, 2)) = ""
outarr = Range(.Cells(1, 1), .Cells(5000, 2))




Set webHTTP = CreateObject("Microsoft.xmlHTTP")
urlstring = "http://www.vbaexpress.com/forum/forum.php"
webHTTP.Open "GET", urlstring, False
webHTTP.send

textmess = webHTTP.responseText


MsgBox textmess
webrows = Split(webHTTP.responseText, Chr(10))
For j = 0 To UBound(webrows) - 1
outarr(j + 1, 1) = webrows(j)
Next j




Range(.Cells(1, 1), .Cells(5000, 2)) = outarr
End With
End Sub