VBA Macro to copy particular "fields" from Web Page into Excel

[bpeacocke]

Hi
I'm trying to write a macro to copy particular "fields" from a web page into excel. I am not sure of the best way to do this. This is what I have thus far ... but I' now a little stuck. Grateful for some assistance. The URL for the web page is in my code:

Sub GetConInfo()

Dim conIE As Object
Dim conTables, conTable
Dim conRows, conRow
Dim conCells, conCell
Dim CrsNum, strBuffer As String
Dim lngColumn As Long
Dim lngRow As Long

' Build URL from CRS number and load contrator detail page
' CrsNum = "https://registers.cidb.org.za/reports/CRSR001_Web.asp?CRSNumber=" & CrsNum
CrsNum = "https://registers.cidb.org.za/reports/CRSR001_Web.asp?CRSNumber=156719"
Set conIE = CreateObject("InternetExplorer.Application")
With conIE
.AddressBar = False
.StatusBar = False
.MenuBar = False
.Toolbar = 0
.Visible = True
.Navigate CrsNum
End With
While conIE.Busy
Wend
While conIE.Document.ReadyState <> "complete"
Wend

Set conTables = conIE.Document.All.Tags("TABLE")
lngRow = 2
For Each conTable In conTables
'Use the innerText to see if this is the table we want.
Debug.Print conTable.Innertext
MsgBox ("conTable is: " + conTable.Innertext)
' If conTable.Innertext Like "Contractor Detail*" Then
If Len(conTable.Innertext) > 0 Then
Set conRows = conTable.Rows
For Each conRow In conRows
Set conCells = conRow.Cells
lngColumn = 2 'This will be the output column
For Each conCell In conCells
strBuffer = conCell.Innertext
ActiveSheet.Cells(lngRow, lngColumn) = conCell.Innertext
lngColumn = lngColumn + 1
Next conCell
lngRow = lngRow + 1
Next conRow
End If
Next conTable
Set conCell = Nothing: Set conCells = Nothing
Set conRow = Nothing: Set conRows = Nothing
Set conTable = Nothing: Set conTables = Nothing
conIE.Quit
Set conIE = Nothing
End Sub