{"id":580,"date":"2019-03-09T23:34:45","date_gmt":"2019-03-09T23:34:45","guid":{"rendered":"http:\/\/www.vbastring.com\/blog\/?p=580"},"modified":"2019-03-09T23:47:13","modified_gmt":"2019-03-09T23:47:13","slug":"website-scraping-vba-code-to-import-data-from-website-to-excel","status":"publish","type":"post","link":"https:\/\/vbastring.com\/blog\/2019\/03\/09\/website-scraping-vba-code-to-import-data-from-website-to-excel\/","title":{"rendered":"Website Scraping – VBA Code To Import Data From Website To Excel"},"content":{"rendered":"

I am going to show you 2 ways of scraping data from a website. One with the standard approach and 1 with JSON.<\/p>\n

For this example, I want the stock numbers from yahoo in my worksheet.<\/p>\n

The site is https:\/\/finance.yahoo.com\/quote\/%5EGSPC\/history?period1=1520575200&period2=1552111200&interval=1d&filter=history&frequency=1d<\/a><\/p>\n

\"\"<\/a><\/p>\n

This data is rendered in a table format so I can use the following code to bring it back to my worksheet:<\/p>\n

Sub ScrapeSite()\r\n    '3\/8\/18 - this is really laggy and slow!\r\n    Dim appIE As Object\r\n    Set appIE = CreateObject(\"InternetExplorer.Application\")\r\n    \r\n    'navigate to the site\r\n    With appIE\r\n        .navigate \"https:\/\/finance.yahoo.com\/quote\/%5EGSPC\/history?p=%5EGSPC\"\r\n        '.Visible = True\r\n    End With\r\n    \r\n    ' Wait while the page is loading\r\n    Do While appIE.Busy\r\n        DoEvents\r\n    Loop\r\n\r\n    Dim Table As Object\r\n    Dim tRows As Object\r\n    Dim tCols As Object\r\n    \r\n    Dim tRow As Object\r\n    Dim tCol As Object\r\n        \r\n    Dim intExcelCol As Integer\r\n    Dim intExcelRow As Integer\r\n    \r\n    Set Table = appIE.document.getElementsByTagName(\"table\")\r\n    \r\n    \r\n    'these debug statements are to tell us where we are in the process.\r\n    Debug.Print \"Set table...\"\r\n    \r\n    'Get the rows\r\n    'set tRows = Table(0).getElementsByTagName(\"tr\")\r\n    \r\n    'sometimes the code stalls and receives an error, but just check your internet connection and rerun the procedure.\r\n    \r\n    'Debug.Print \"Got Rows...\"\r\n    \r\n    'Get the column headings which use the \"td\" tag\r\n    Set tCols = Table(0).getElementsByTagName(\"td\")\r\n    \r\n    Debug.Print \"Got Columns...\"\r\n    \r\n    intExcelRow = 2\r\n    intExcelCol = 1\r\n    \r\n    For Each tCol In tCols\r\n        'after filling in 8 columns move to the next row\r\n        If intExcelCol <= 7 Then\r\n            ' Output the contents of the cell to the spreadsheet\r\n            Debug.Print tCol.innerText\r\n            Sheet1.Cells(intExcelRow, intExcelCol) = tCol.innerText\r\n        \r\n            'Increase the intExcelCol value so the next time around the data will output to the next column\r\n            intExcelCol = intExcelCol + 1\r\n        Else\r\n            intExcelRow = intExcelRow + 1\r\n            intExcelCol = 0\r\n            \r\n            Debug.Print \"Row: \" & intExcelRow\r\n            \r\n        End If\r\n    Next\r\n\r\n    \r\n    \r\n    appIE.Quit\r\n    \r\n    Set tRow = Nothing\r\n    Set tRows = Nothing\r\n    Set tCol = Nothing\r\n    Set tCols = Nothing\r\n    \r\n    Set appIE = Nothing\r\n\r\n    MsgBox \"Done\"\r\n    \r\nEnd Sub\r\n<\/pre>\n
This method worked buy was very clunky and slow.<\/strong>  <\/p>\n
One of the big things with web scraping involves getting the tables and rows in the table, and then returning the items back to your sheet, and that’s what the example above does.<\/p>\n
This slow and sketchy method wouldn’t work for me.  So I needed another way.  <\/p>\n
The data I want is really just a JSON string.  <\/p>\n
\"\"<\/a><\/p>\n
JSON supposedly replaced XML as a standard way of transferring data. <\/p>\n
Anyway that’s fine, but Yahoo is speedily rendering stock quotes via a JSON string.  <\/p>\n
So what we are looking for is the data after the “HistoricalPriceStore” text.  If you want to know if you are dealing with a proper JSON string, paste your string into http:\/\/json.parser.online.fr\/<\/a><\/p>\n
\"\"<\/a><\/p>\n
So, yes, that assessment is correct.  So you can use the following faster code to scrape the information:<\/p>\n
Sub ParseMultipleRowsJSON()\r\n\r\n    Dim http As New XMLHTTP 'ms xml object library 3.0\r\n    Dim html As New HTMLDocument 'ms html object library\r\n    \r\n    Dim varResponse As Variant\r\n    Dim dict As Dictionary  'reference ms scripting runtime for this\r\n    \r\n    Dim intJSONRows As Integer\r\n    Dim intJSONCols As Integer\r\n    \r\n    Dim strDate As String\r\n    \r\n    strurl = \"https:\/\/finance.yahoo.com\/quote\/%5EGSPC\/history?p=%5EGSPC\"\r\n    \r\n    'json online parser at: http:\/\/json.parser.online.fr\/ (to see if your text is a valid json string)\r\n    \r\n    With http\r\n        .Open \"GET\", strurl, False\r\n        .send\r\n        'varResponse(1) has the json string\r\n        varResponse = Split(.responseText, \"HistoricalPriceStore\"\":\")\r\n        \r\n    End With\r\n    \r\n    'this is using the JsonConverter.bas found at https:\/\/github.com\/VBA-tools\/VBA-JSON (just copy and paste into a module)\r\n    Set dict = ParseJson(varResponse(1))\r\n    \r\n    'initialize the excel destination vars\r\n    intExcelRow = 2\r\n    intExcelCol = 1\r\n    \r\n    Set JSONRowsCollection = dict(\"prices\")\r\n    For intJSONRows = 1 To JSONRowsCollection.Count\r\n        \r\n        Set JSONColsCollection = JSONRowsCollection(intJSONRows)\r\n        'For intJSONCols = 1 To JSONColsCollection.Count\r\n            'If intExcelCol > 7 Then\r\n            '    intExcelCol = 1\r\n            'Else\r\n             \r\n             \r\n             '(((A1\/60)\/60)\/24)+DATE(1970,1,1) - convert the unix date to regular number 43532.60417\r\n\r\n             strdate1 = JSONColsCollection(\"date\") \/ 60 \/ 60 \/ 24\r\n             strDate = strdate1 + DateValue(\"1\/1\/1970\")\r\n             'now format the date as date\r\n             \r\n             \r\n            Sheet1.Cells(intExcelRow, 1) = strDate 'Unix Timestamp date - need to convert\r\n            Sheet1.Cells(intExcelRow, 2) = JSONColsCollection(\"open\")\r\n            Sheet1.Cells(intExcelRow, 3) = JSONColsCollection(\"high\")\r\n            Sheet1.Cells(intExcelRow, 4) = JSONColsCollection(\"low\")\r\n            Sheet1.Cells(intExcelRow, 5) = JSONColsCollection(\"close\")\r\n            Sheet1.Cells(intExcelRow, 6) = JSONColsCollection(\"volume\")\r\n            Sheet1.Cells(intExcelRow, 7) = JSONColsCollection(\"adjclose\")\r\n                'Debug.Print JSONColsCollection(\"date\")\r\n            'End If\r\n            \r\n            'intExcelCol = intExcelCol + 1\r\n            \r\n        'Next intJSONCols\r\n        \r\n        intExcelRow = intExcelRow + 1\r\n    Next intJSONRows\r\n    \r\n    'clean up\r\n    Set http = Nothing\r\n    Set html = Nothing\r\n\r\nEnd Sub<\/pre>\n
Your end product should look like this:<\/p>\n
\"\"<\/a><\/p>\n
(no, I didn’t author all of this code, I got the ideas from various places on the internet, and put all the “pieces” together \ud83d\ude42 .  So kudos to all those wonderful people out there, which share their knowledge with us. Thanks!)<\/p>\n
Let me know if you have any questions.<\/p>\n
****************************************************<\/p>\n\n\n
\n
<\/div>\n