View Single Post
  #2  
Old 24th August 2012, 01:06 PM
Shaun Shaun is offline
Member
 
Join Date: Jan 1970
Location: Western Australia
Posts: 3,408
Default

Here is the code i have for the other site.

Code:
Private Function HttpGetRequest(Url As String) As String 'Function submits a GET request, returns a server response Dim xmlReq As ServerXMLHTTP60 Set xmlReq = New ServerXMLHTTP60 xmlReq.Open "GET", Url xmlReq.setRequestHeader "User-Agent", "Excel 2002 :)" xmlReq.send If xmlReq.Status <> 200 Then MsgBox "Error occured: " & xmlReq.statusText: Exit Function HttpGetRequest = xmlReq.responseText End Function Sub Test() Dim servResp As String Dim htmlDoc As HTMLDocument, myTable As IHTMLTable, myTableRow As IHTMLTableRow, myCell As IHTMLTableCell Dim i As Long, r As Long, c As Long, colSpan As Long 'Record server response into a string variable servResp = HttpGetRequest("http://www.puntingform.com.au/form-guide/race/bathurst-26-06-2012-1-form/") 'Creats a new object, assigns its .body.innerHTML property from server response Set htmlDoc = New HTMLDocument htmlDoc.body.innerHTML = servResp 'If you check your webpage source code _ you'll see that the table you need has a class name 'Table7' _ (table class="Table7"). _ This allows us to use .getElementsByClassName method to _ put this table into a new object of IHTMLTable type. _ There 's only one table on the page page, that's why it's .Item(0) Set myTable = htmlDoc.getElementsByClassName("Table7").Item(0) 'Iterate through each table row in our table rows collection For Each myTableRow In myTable.Rows c = 0 colSpan = 0 'Iterate through each table cell in our table rows collection For Each myCell In myTableRow.Cells 'Table header captions span over several cells: th colspan="7" _ so for 1st row only we need colspan values to later record these cells text _ into appropriate columns in Excel If r = 0 Then colSpan = myCell.getAttribute("colspan") - 1 End If 'Some cells in 2nd row don't have any text. _ But they have IMG tags which have despriptive TITLE attribute we can use If r = 1 Then If Len(myCell.innerText) > 0 Then Sheet1.Range("A1").Offset(r, c) = myCell.innerText Else Sheet1.Range("A1").Offset(r, c) = myCell.getElementsByTagName("IMG").Item(0).getAttribute("TITLE") End If Else Sheet1.Range("A1").Offset(r, c) = myCell.innerText End If c = c + 1 + colSpan Next myCell r = r + 1 Next myTableRow End Sub
__________________
One Drive

"If the corporates are treating you poorly , just go elsewhere."
"If they need you , they will soon find out."
"If you need them , you will soon find out."
--moeee
_______________________________________________
Reply With Quote