using From Web Query in a loop - vba

Question

I am trying to pull data from this website: http://securities.stanford.edu/filings.html?page=1
Each "page" is a table with 21 items. There are 97 pages I would like to pull data from, but I am unable to automate it so that the macro cycles through all 97, and places the results every 21 rows, starting on cell A1. (sequence: a1, a22, a43, ect...)
this what I got, but I dont want to edit the code 97 time to get all the pages. Any idea how I could automate the task?
Sub Macro1()
' Macro1 Macro
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://securities.stanford.edu/filings.html?page=1", Destination:=Range( _
"A1"))
.Name = "filings.html?page=1"**
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
end Sub

Answer 1

For x = 1 to 97
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://securities.stanford.edu/filings.html?page=" & x, Destination:=Range( _
"A" & (1 + ((x - 1) * 21)))
.Name = "filings.html?page=" & x
End With
Next
x contains page number and the cell is complicated to make it start at A1 rather than A21.
You could make it 0 to 96 and cell & (1 + (x + 21)) and the name and query x + 1.

Answer 2

I would abandon the 'from Web Query' method and delve into some xmlHTTP. For the following, you will have use the VBE's Tools ► References to add Microsoft HTML Object Library, Microsoft Internet Controls and Microsoft XML 6.0.
Option Explicit
Sub mcr_Collect_Filings()
Dim htmlBDY As HTMLDocument, xmlHTTP As New MSXML2.ServerXMLHTTP60
Dim rw As Long, pg As Long, iTH As Long, iTD As Long, iTR As Long
Dim eTBL As MSHTML.IHTMLElement
For pg = 1 To 99 '<-set to something reasonable; routine will kick out whehn it cannot find anything more
xmlHTTP.Open "GET", "http://securities.stanford.edu/filings.html?page=" & pg, False
xmlHTTP.setRequestHeader "Content-Type", "text/xml"
xmlHTTP.send
If xmlHTTP.Status <> "200" Then GoTo bm_CleanUp
Set htmlBDY = New HTMLDocument
htmlBDY.body.innerHTML = xmlHTTP.responseText
Set eTBL = htmlBDY.getElementById("records").getElementsByTagName("table")(0)
If eTBL Is Nothing Then GoTo bm_CleanUp
'skip the header row if on page 2 and above
With Sheet1 '<-worksheet codename
rw = .Cells(Rows.Count, 1).End(xlUp).Row
For iTR = (1 + (pg = 1)) To (eTBL.getElementsByTagName("tr").Length - 1)
For iTH = 0 To (eTBL.getElementsByTagName("tr")(iTR).getElementsByTagName("th").Length - 1)
.Cells(rw, 1).Offset(iTR, iTH) = _
eTBL.getElementsByTagName("tr")(iTR).getElementsByTagName("th")(iTH).innerText
Next iTH
For iTD = 0 To (eTBL.getElementsByTagName("tr")(iTR).getElementsByTagName("td").Length - 1)
.Cells(rw, 1).Offset(iTR, iTD) = _
eTBL.getElementsByTagName("tr")(iTR).getElementsByTagName("td")(iTD).innerText
Next iTD
Next iTR
End With
Next pg
bm_CleanUp:
Set eTBL = Nothing
Set htmlBDY = Nothing
Set xmlHTTP = Nothing
End Sub
The XMLHTTP is invisible so you have to know a little about the page and what to expect in the form of HTML code you are going to receive under different circumstances. A browser's Inspect Element command take care of that.
This is by far the fastest method in VBA. While you actually have more than 99 rows to retrieve, this went to 99 pages in 56.3 seconds. You might even speed that up a bit by turning off screen updating.