-
API Help Needed
Hi everyone,
I am working on my first code and I am trying to scrape data from the Federal Reserve.
Here is my code:
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
-
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.
-
Apply an Excel querytable
-
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.
Code:
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