Automate Excel Web Queries using a Crawler: Downloading Historical Data

In a previous article, I wrote about clearing the cache for your Excel web queries in VBA and disabling background queries. However, that method is less flexible and requires you to specific tables for Excel to extract the data from. Here, I recommend a method to perform web queries using a so-called "XMLHTTP" object, which is potentially much faster than a typical data connection. It downloads the html source of your data source as text, searches for a stipulated number of characters after a particular date, e.g. 25-June-09 and removes the html tag, leaving the data you want. The following example provides the necessary VBA code to crawl a hypothetical website, finance.goohoo.com for historical financial data on the Dow Jones Industrial Average Index DJIA.

Step 1: Set up workbook

Download the component stocks of the DJIA and set up your spreadsheet like the picture below. Column A shall be your stock symbols, followed by the stock name and the URL where you want to download the data from for each stock. This spreadsheet assumes that the URL of your data source is structured in the following way.

e.g. http://finance.goohoo.com/q/hp?s=^DJI, where the last four characters represent the stock symbol of each company.

Column E shows the dates that have the financial data you want. You should into Column E samples of data you want to extract. In this case, I input the respective dates I want to macro to search for. You have to check for yourself that the URL in Column C will have the dates that you want. Input an arbitrary value of 600 into Cell G2.

In a second sheet, fill the first row with the following headers, "Date, Company, Extracted Text," followed by "Open, High, Low, Close, Volume" or whatever order the data from your source comes with.

Step 2: Coding - Download Data

Copy the following VBA code in. My comments are in bold so that they stand out from the VBA coding. They will explain the macros along the way.

Sub getdata()

'Dim your variables

Dim url1 As String

Dim date1 As String

Dim http1 As Object

Dim start1 As Long

Dim length1 As Long

'Store the value in cell G2 earlier as length1

length1 = Sheet1.Range("G2").Value

'Sheet1.Range("C2:C32") is the list of URL from earlier

'rcell is a variable to refer to each URL in the list

For Each rcell In Sheet1.Range("C2:C32")

url1 = rcell.Value

'Let Excel know that http1 is a XMLHTTP object

Set http1 = CreateObject("MSXML2.XMLHTTP")

'The open method initializes a GET request

'from the WWW as specified by url1,

'The option FALSE makes sure that the download

'is completed before the macro continues.

http1.Open "GET", url1, False

'The send Method sends to the URL the request from

'the Open method and receives the response

http1.Send

'In this case, the response is a html file, and the line

'below stores the html code as text in the variable

'text1.

text1 = http1.responseText

'Format Sheet2

'Pasting the dates and quote symbols over

With Sheet2

lastrow = .Cells(1000000, 1).End(xlUp).Row + 1

Sheet1.Range("E2:E20").Copy .Cells(lastrow, 1)

lastrow1 = .Cells(1000000, 1).End(xlUp).Row

Range(.Cells(lastrow, 2), .Cells(lastrow1, 2)).Value = rcell.Offset _

(0, -2).Value

End With

'Below does this: For each data listed in Range("E2:E2o")

'Find the following string, e.g. ">5-Jun-09"

'Adding ">" in front makes sure that you get 5-Jun-09 data not

'25-Jun-09 data. This assumes that your data source html file

'surrounds your dates with in a table with lots of

For Each bcell In Sheet1.Range("E2:E20")

b = Len(Day(bcell.Value))

If b = 1 Then

date1 = ">" & Format(bcell.Value, "d-mmm-yy")

Else

date1 = ">" & Format(bcell.Value, "dd-mmm-yy")

End If

start1 = InStr(1, text1, date1, vbTextCompare)

'Once the date is found in the html, store the next

'600 characters as specified in the column

'Extracted Text

lastrow = Sheet2.Cells(1000000, 3).End(xlUp).Row + 1

Sheet2.Cells(lastrow, 3).Value = Mid(text1, start1 + 1, length1)

'loop to next date but stay in same url

Next bcell

'loop to next url/company

Next rcell

'Call the macro to do the formating work

Call formating1

End Sub

Sub formating1()

'Assuming that the data you want is bounded by

'html tags e.g.

'>DD-MMM-YY$1.01

'The replace method below replaces the html tags

'with /

Sheet2.Cells.Replace What:="<*>", Replacement:="/", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

'This method removes the broken

'at the last few characters of the 600 character string

Sheet2.Cells.Replace What:="<*", Replacement:="", _

LookAt:=xlPart, SearchOrder:=xlByRows, _

MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

'converts your data to columns, treating consecutive // as

'one delimiter.

Sheet2.Columns(3).TextToColumns , DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _

:="/"

End Sub

Your output should look like below. As 600 characters were extracted for each date, some excess data can be found from Column J onwards. These data can be further screened to see if the same date, e.g. 3 Jun 09 for BAC, appears twice, once for the price data and once for the dividend data. You will notice that this macro will run considerably faster than its conventional web query equivalent.

Indeed, this macro works more like a web crawler and can be easily amended to retreive live quotes. It resolves the bugs that arise when looping through multiple web queries. AND it is more flexible. The sample code and file can be downloaded from the links below. Remember to change the URL links. I left them as goohoo.com. Click here to view Method A.

[Latest Note: Kind miken in the comments section below alerted me to some issues with this method. I did some checking. Firstly, google has amended its URL for price data. As such, the sample spreadsheet I provided may require some updating on your own. 

Secondly, the sample spreadsheet is saved in an older version of excel which only had 65,000 plus rows. I coded it to read row 1million as the last row as I was using a new version of excel. You will have to change that part of the code as well. 

Therefore, the code below and the sample spreadsheet are only for your reference. You probably will have to amend it to achieve the results you want. 

I am deferring the update of this spreadsheet till later, as I am currently working on other parts of this website]

Download link: http://sites.google.com/site/finance4traders/Home/CrawlerFinal.xls?attredirects=0

Alt: http://sites.google.com/site/finance4traders/

Note: Spreadsheets provided by finance4traders.blogspot.com are provided without warranty. Users should not be using them for any unlawful activity.

References

http://msdn.microsoft.com/en-us/library/ms757849(VS.85).aspx

On the Open method

http://msdn.microsoft.com/en-us/library/ms763706(VS.85).aspx

On the Send method

http://msdn.microsoft.com/en-us/library/ms762275(VS.85).aspx

On the ResponseText property

Like what you have just read? Digg it or Tip'd it.

The objective of Finance4Traders is to help traders get started by bringing them unbiased research and ideas. Since late 2005, I have been developing trading strategies on a personal basis. Not all of these models are suitable for me, but other investors or traders might find them useful. After all, people have different investment/trading goals and habits. Thus, Finance4Traders becomes a convenient platform to disseminate my work...(Read more about Finance4Traders)

Automate Multiple Excel Web Queries: Downloading Historical Data

Looping Web Queries Faster and Easier in VBA without the interuptions

There are two major poblems with using VBA to perform web queries, that will cause Excel to bug out and show the 1004 or its equivalent Error message.

1) Excel actually reads from your internet explorer when performing queries. When your cache is full, usually by the 40^th to 50^th query, your macro will bug out.

2) Excel will move on to the next query when the last one is still refreshing in the background in the case of multiple web queries.

I suggest two methods to resolve these issues. Method A adds VBA code to clear your cache when an error occurs. Additional VBA code is also provided to disable background queries and wait for a while before continuing at each web query. Method B performs the same web query as an MSXML2.XMLHTTP object. However, Method B functions more like a web crawler and is much more flexible. It allows you to search for specific data to copy into Excel, and in my opinion, is faster and more efficient than Method A.

Method A

The code to clear your cache is:

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "

Note that I only tested this code on XP. Changing the number at the end of the line tells your machine to clear different items.

Clear temp files: 8

Clear history: 1

Clear cookies: 2

Clear form data: 16

Clear saved passwords: 32

Clear everything: 255

Clear add on settings: 4351

The following tells Excel not to perform queries in the background.

With ActiveSheet.QueryTables("ABC").Refresh backgroundquery:=False

If setting background queries to false does not work, you can manually ask Excel to wait for a while before continuing.

Application.Wait (Now() + TimeValue("0:00:05"))

The following code provides you with an example of pulling historical stock prices for multiple companies from a hypothetical website called goohoo.com via web queries. It requires that you input a starting date into a cell that has been named as "Start_Date". To name a cell, select the cell and click Formulas>>Define Name. It assumes that you want historical data up till yesterday and will also pop up an input box asking you to select the range of cells where your stock symbols are located, before continuing with the web queries. Comments are in bold.

'Declare variables

Dim symbolrange As Range

Dim ws As Worksheet

Dim ws1 As Worksheet

Dim ws2 As Worksheet

Dim url1 As String

Dim url2 As String

Dim ie As InternetExplorer

Sub main1()

'create an inputbox for user to specify range

On Error GoTo Handler 'if you click cancel on the pop up, exit macro

Set symbolrange = Application.InputBox _

("Select Range Containing Stock Symbols", _

"Select Range", Selection.Address(0, 0), Type:=8)

On Error GoTo 0 'Disable the error handler that we turned on above

Call setdate 'A macro to create part of the URL

Call setupconnection 'A macro to set up connection

Call grabdata 'A macro to loop data connection

Handler:

End Sub

Sub setdate()

'This macro converts date into partial URL

startdate = Range("Start_Date").Value

enddate = Date - 1

'Check if Startdate is correct

If startdate >= enddate Then

MsgBox "Your start date is later than your end date"

End

End If

'Check if startdate is too early

If enddate - startdate > 5000 Then

yesno = MsgBox _

("Confirm that your source supports this date range", vbYesNo)

If yes = vbNo Then End

End If

'If above checks are ok continue below

startmonth = WorksheetFunction.Text(Month(startdate) - 1, "00")

startday = Day(startdate)

startyear = Year(startdate)

startdate1 = "&a=" & startmonth & "&b=" & startday & "&c=" _

& startyear

startmonth = WorksheetFunction.Text(Month(enddate) - 1, "00")

startday = Day(enddate)

startyear = Year(enddate)

enddate1 = "&d=" & startmonth & "&e=" & startday & "&f=" _

& startyear

'url1 forms the partial url that dictates the date range

url1 = startdate1 & enddate1

End Sub

Sub setupconnection()

'On error go to line with the words error1

On Error GoTo error1

Set ws = ActiveSheet

'Create a new spreadsheet to store connection

Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = _

"Data Connection" & Worksheets.Count

Set ws1 = ActiveSheet

'Set url2 to the url you are surfing to

'REMEMBER to change goohoo.com to the real

'website

url2 = "http://finance.goohoo.com/q/hp?s=" & _

symbolrange(1, 1) & url1 & "&g=d&z=66&y=" & 0

'Add a connection

'REMEMBER to change goohoo.com to the real

'website

With ws1.QueryTables.Add(Connection:= _

"URL;http://finance.goohoo.com/q/hp?s=" & _

symbolrange(1, 1) & url1 & "&g=d&z=66&y=" & _

0, Destination:=ws1.Range("$A$1"))

.Name = "Hist_Data"

.FillAdjacentFormulas = False

.WebSelectionType = xlSpecifiedTables

.WebTables = "20"

.BackgroundQuery = False

.Refresh BackgroundQuery:=False

'You can remove the line for excel to wait if you

'successfully disable background query.

'Making Excel wait 3 seconds is very long

Application.Wait (Now() + TimeValue("00:00:03"))

End With

On Error GoTo 0

'Exit sub to prevent the macro from

'running the lines after error1 when

'there is no error.

Exit Sub

error1:

'Clear temp files

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "

Resume

End Sub

Sub grabdata()

On Error GoTo error1

For Each rcell In symbolrange

'Create a new spreadsheet to store each stock's data

Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = _

rcell.Value & Worksheets.Count

Set ws2 = ActiveSheet

'Create a loop to keep grabbing data until complete

stock1 = rcell.Value

a = -1

Do

a = a + 1

'Remember to change goohoo.com

url2 = "http://finance.goohoo.com/q/hp?s=" & _

rcell.Value & url1 & "&g=d&z=66&y=" & a * 66

With ws1.QueryTables("Hist_Data")

.Connection = "URL;" & url2

.Refresh BackgroundQuery:=False

'You can remove the line for excel to wait if you

'successfully disable background query.

'Making Excel wait 3 seconds is very long

Application.Wait (Now() + TimeValue("00:00:03"))

End With

'Copy data onto correct spreadsheet

lastrow = ws2.Cells(65000, 1).End(xlUp).Row

If a = 0 Then

ws1.Range("Hist_Data").Copy

ws2.Cells(lastrow, 1).PasteSpecial xlPasteValuesAndNumberFormats

Else

ws1.Range("Hist_Data").Offset(1, 0).Copy

ws2.Cells(lastrow, 1).PasteSpecial xlPasteValuesAndNumberFormats

End If

Application.CutCopyMode = False

lastrow = ws2.Cells(65000, 1).End(xlUp).Row

Loop Until ws1.Cells(1, 1).Value = ws2.Cells(lastrow, 1).Value

Next rcell

On Error GoTo 0

'Exit sub to prevent the macro from

'running the lines after error1 when

'there is no error.

Exit Sub

error1:

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "

Resume

End Sub

You can download the sample code for Method A from here or (Alt Link). Click here to view Method B which is more flexible and, I believe, more efficient.

Note: Spreadsheets provided by finance4traders.blogspot.com are provided without warranty. Users should not be using them for any unlawful activity.

Some References

http://support.microsoft.com/kb/141571/EN-US/

Information on error handling in VBA from Microsoft

Like what you have just read? Digg it or Tip'd it.

The objective of Finance4Traders is to help traders get started by bringing them unbiased research and ideas. Since late 2005, I have been developing trading strategies on a personal basis. Not all of these models are suitable for me, but other investors or traders might find them useful. After all, people have different investment/trading goals and habits. Thus, Finance4Traders becomes a convenient platform to disseminate my work...(Read more about Finance4Traders)