Web scrape

S

Steve_R

Active Member
Joined
Oct 28, 2015
Messages
350
Hi

I've done a lot with VBA over the years but never used VBA to scrape data using IE or HTML.

I tried using a number of methods posted within the forum but every time I run into a problem I cannot solve. I suspect the following should do the trick but it breaks 'Object required'


Code: 
Const sWebPage = "http://www.bom.gov.au/products/IDN60701/IDN60701.95929.shtml"




Sub Web_Table_Option_One()


Dim xml    As Object
Dim html   As Object
Dim objTable As Object
Dim result As String
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", sWebPage, False
.send
End With
result = xml.responseText
Set html = CreateObject("htmlfile")
html.body.innerHTML = result

'Breaks on the line below Error 424 Object required. I think my problem is in Item and Tag Names

Set objTable = IE.Document.all.Item("{What should this be}").getElementsByTagName("{What should this be}") (0)

' Can't test the following yet
 For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable

    Set xml = Nothing    
    Set html = Nothing
    Set objTable = Nothing
End Sub


The table wanted is t2 (identified from the following behind the webpage)

table id="t2" border="1" cellspacing="0" class="tabledata obs_table"
Click to expand...


Small sample of required result (will insert headings later)

Excel 2010
ABCDEFGHIJKLMNO
01/11:30pmCALM--Partly cloudy----
01/11:00pmCALM-------
01/10:30pmCALM-------

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]2[/TD]

[TD="align: right"]17.2[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]1011.3[/TD]

[TD="align: right"]0.4[/TD]

[TD="align: right"]10[/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]17.2[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]1011.4[/TD]

[TD="align: right"]0.4[/TD]

[TD="align: right"]10[/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]17.6[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]1011.5[/TD]

[TD="align: right"]0.4[/TD]

[TD="align: right"]10[/TD]

</tbody>
Sheet1​
I am open to using Internet Explorer instead.
 
Sort by date Sort by votes
Hi,
Try this:
Rich (BB code): 
Sub Web_Table_Option_One()
 
  Const sWebPage = "http://www.bom.gov.au/products/IDN60701/IDN60701.95929.shtml"
 
  Dim a()
  Dim c As Long, cs As Long, r As Long, rs As Long
  Dim oDom As Object, oRow As Object, oCell As Object
 
  ' Copy HTML text of the web page to the oDom for farther parsing
  Set oDom = CreateObject("htmlfile")
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", sWebPage, False
    .Send
    oDom.body.innerHTML = .responseText
  End With
 
  ' Fill a() by HTML Table content
  With oDom.body.document.getElementById("t2")
    rs = .Rows.Length + 1
    ReDim a(1 To rs, 1 To 100)
    For Each oRow In .Rows
      r = r + 1
      For Each oCell In oRow.Cells
        c = c + 1
        a(r, c) = Replace(oCell.innerText, vbCr, vbNullString)
      Next
      If cs < c - 1 Then cs = c - 1
      c = 0
    Next
  End With
  ReDim Preserve a(1 To rs, 1 To cs)
 
  ' Write the extracted data to the Sheet1
  With Sheets("Sheet1").Range("A1")
    .CurrentRegion.ClearContents
    .Resize(rs, cs).Value = a()
    .Resize(rs, cs).EntireColumn.AutoFit
  End With
 
  ' Release the memory of the object variables
  Set oRow = Nothing
  Set oCell = Nothing
  Set oDom = Nothing
 
End Sub
 
Upvote 0
The same but with error trapping of web page request
and 2 rows skipping of the header with merged cells
Rich (BB code): 
Sub Web_Table_Option_One()
 
  Const sWebPage = "http://www.bom.gov.au/products/IDN60701/IDN60701.95929.shtml"
 
  Dim a()
  Dim c As Long, cs As Long, r As Long, rs As Long, i As Long
  Dim oDom As Object, oRow As Object, oCell As Object
 
  ' Copy HTML text of the web page to the oDom for farther parsing
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", sWebPage, False
    .Send
    If .readyState = 4 And .Status = 200 Then
      Set oDom = CreateObject("htmlfile")
      oDom.body.innerHTML = .responseText
    Else
      MsgBox "Ready state: " & .readyState & vbLf & "HTTP request status: " & .Status, vbExclamation, "Error"
      Exit Sub
    End If
  End With
 
  ' Fill a() by HTML Table content
  With oDom.body.document.getElementById("t2")
    rs = .Rows.Length - 1
    ReDim a(1 To rs, 1 To 100)
    For Each oRow In .Rows
      i = i + 1
      If i > 2 Then
        r = r + 1
        For Each oCell In oRow.Cells
          c = c + 1
          a(r, c) = Replace(oCell.innerText, vbCr, vbNullString)
        Next
        If cs < c - 1 Then cs = c - 1
        c = 0
      End If
    Next
  End With
  ReDim Preserve a(1 To rs, 1 To cs)
 
  ' Write the extracted data to the Sheet1
  With Sheets("Sheet1").Range("A3").Resize(rs, cs)
    With .CurrentRegion
      If Rows.Count > 2 Then .Resize(.Rows.Count - 2).Offset(2).ClearContents
    End With
    .Value = a()
    .EntireColumn.AutoFit
  End With
 
  ' Release the memory of the object variables
  Set oRow = Nothing
  Set oCell = Nothing
  Set oDom = Nothing
 
End Sub
 
Upvote 0
Please replace this: If cs < c - 1 Then cs = c - 1
by that: If cs < c Then cs = c

The data rows looks like this:
[TABLE="class: head"]
<tbody>[TR="bgcolor: #888888"]
[TH][/TH]
[TH]
A​
[/TH]
[TH]
B​
[/TH]
[TH]
C​
[/TH]
[TH]
D​
[/TH]
[TH]
E​
[/TH]
[TH]
F​
[/TH]
[TH]
G​
[/TH]
[TH]
H​
[/TH]
[TH]
I​
[/TH]
[TH]
J​
[/TH]
[TH]
K​
[/TH]
[TH]
L​
[/TH]
[TH]
M​
[/TH]
[TH]
N​
[/TH]
[TH]
O​
[/TH]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
1​
[/TD]
[TD="bgcolor: #CCFFFF"]
Date/Time
EDT​
[/TD]
[TD="bgcolor: #CCFFFF"]
Temp
°C​
[/TD]
[TD="bgcolor: #CCFFFF"]
Wind​
[/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"]
Pressure​
[/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"]
Rain since
9am
mm​
[/TD]
[TD="bgcolor: #CCFFFF"]
Weather​
[/TD]
[TD="bgcolor: #CCFFFF"]
Cloud​
[/TD]
[TD="bgcolor: #CCFFFF"]
Vis
km​
[/TD]
[TD="bgcolor: #CCFFFF"]
Sea
Height
m​
[/TD]
[TD="bgcolor: #CCFFFF"]
Swell​
[/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
2​
[/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"]
Dir​
[/TD]
[TD="bgcolor: #CCFFFF"]
Spd
kts​
[/TD]
[TD="bgcolor: #CCFFFF"]
Gust
kts​
[/TD]
[TD="bgcolor: #CCFFFF"]
hPa​
[/TD]
[TD="bgcolor: #CCFFFF"]
Trend​
[/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"][/TD]
[TD="bgcolor: #CCFFFF"]
Height
m​
[/TD]
[TD="bgcolor: #CCFFFF"]
Period
s​
[/TD]
[TD="bgcolor: #CCFFFF"]
Dir​
[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
3​
[/TD]
[TD]01/11:30pm[/TD]
[TD]
17.2​
[/TD]
[TD]CALM[/TD]
[TD]
0​
[/TD]
[TD]
0​
[/TD]
[TD]
1011.3​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]-[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
4​
[/TD]
[TD]01/11:00pm[/TD]
[TD]
17.2​
[/TD]
[TD]CALM[/TD]
[TD]
0​
[/TD]
[TD]
0​
[/TD]
[TD]
1011.4​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
5​
[/TD]
[TD]01/10:30pm[/TD]
[TD]
17.6​
[/TD]
[TD]CALM[/TD]
[TD]
0​
[/TD]
[TD]
0​
[/TD]
[TD]
1011.5​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
6​
[/TD]
[TD]01/10:00pm[/TD]
[TD]
17.6​
[/TD]
[TD]NNW[/TD]
[TD]
1​
[/TD]
[TD]
4​
[/TD]
[TD]
1011.8​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
7​
[/TD]
[TD]01/09:30pm[/TD]
[TD]
17.9​
[/TD]
[TD]SSW[/TD]
[TD]
3​
[/TD]
[TD]
5​
[/TD]
[TD]
1011.7​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
8​
[/TD]
[TD]01/09:00pm[/TD]
[TD]
18.2​
[/TD]
[TD]SW[/TD]
[TD]
5​
[/TD]
[TD]
6​
[/TD]
[TD]
1011.5​
[/TD]
[TD]-[/TD]
[TD]
0.4​
[/TD]
[TD]Recent precip.[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
9​
[/TD]
[TD]01/08:30pm[/TD]
[TD]
18.5​
[/TD]
[TD]CALM[/TD]
[TD]
0​
[/TD]
[TD]
0​
[/TD]
[TD]
1011​
[/TD]
[TD]-[/TD]
[TD]
0.2​
[/TD]
[TD]-[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
10​
[/TD]
[TD]01/08:00pm[/TD]
[TD]
18.9​
[/TD]
[TD]WNW[/TD]
[TD]
6​
[/TD]
[TD]
8​
[/TD]
[TD]
1011.6​
[/TD]
[TD]-[/TD]
[TD]
0​
[/TD]
[TD]-[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
11​
[/TD]
[TD]01/07:30pm[/TD]
[TD]
18.9​
[/TD]
[TD]NNW[/TD]
[TD]
3​
[/TD]
[TD]
6​
[/TD]
[TD]
1011.2​
[/TD]
[TD]-[/TD]
[TD]
0​
[/TD]
[TD]-[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD="bgcolor: #888888"]
12​
[/TD]
[TD]01/07:00pm[/TD]
[TD]
19​
[/TD]
[TD]CALM[/TD]
[TD]
0​
[/TD]
[TD]
0​
[/TD]
[TD]
1011.5​
[/TD]
[TD]-[/TD]
[TD]
0​
[/TD]
[TD]-[/TD]
[TD]Partly cloudy[/TD]
[TD]
10​
[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[TD]-[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: Sheet1[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
Steve_R said:
Thank you.
Click to expand...
You are welcome!
There is also "t3" table on that web page, append its content to the result if needed.
Good luck!
 
Last edited:
Upvote 0
Thank you. I had already tested "t1" and 't3" using your code and eventually plan to sit down and work out how to flexibly append the combination required.

The code seems significantly faster than my data query method that broke. The website was up but data query VBA was not grabbing the data. When tested in a separate workbook it failed at the line (.Refresh... ). The error is forgotten - "424 Object required", I think. When testing both your code and my data query code, data query broke and your code worked. Today data query works again. It occurred to me today that restart PC may have cured the problem but it's too late to test that now. Irrespective, it seems the WB may benefit from a change of method.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
How to clean scrape a website for financial data?
2
Replies
17
Views
842
Edgar_
Edgar_
9518423044
  • Question Question
I want to minimize this code. It takes a lot of time to do it. Is it? It is amazon data scraping code
Replies
5
Views
359
Joe4
Joe4
H
  • Solved
Macro to extract text to Body in Email and Table at end of Body
Replies
1
Views
679
howard
H
O
  • Solved
Unable to download html data from specific site
Replies
7
Views
551
Edgar_
Edgar_
Emka
  • Question Question
Web Scrap on Chrome via VBA
Replies
0
Views
245
Emka
Emka

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top