PDA

View Full Version : Excel import Help Requiered


Shaun
24th August 2012, 12:03 PM
Ok he is a tough one, need help to get this page in to excel but i need the info located under the "Profile" tab, need a macro to do it.

http://horseform.racingandsports.com.au/viewHorse.asp?id=3DD7E474157493D55E8D22

The info is not accessible from the link, would need to access the script on the page, i have some macro that may contain the answer but i am not fully sure it it'd workings.

this macro get data from another site that is not available via a normal web query.

Shaun
24th August 2012, 12:06 PM
Here is the code i have for the other site.


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

Shaun
26th August 2012, 12:06 PM
Just an update, i have the info i need.

http://horseform.racingandsports.com.au/getHorseForm.asp?lan=&id=3EDAE475107993D55E8D22&optionType=&refID=&pagetype=profile

The information i gained will enable me to gather more info from the R&S site.