IE VBA Web Scrapping Table extract issue

[Pankil]

Hello Guys,

i have below code that copy table on current webpage but when i change that page it not getting new table. note both the tables have same format, with little change in content,

Dim i As SHDocVw.InternetExplorer
Set i = New InternetExplorer
Dim clipboard As MSForms.DataObject
i.Visible = True
Dim HTMLdoc As New HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable
Dim objTable As Object
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long

i.navigate ("URL")

Do While i.readyState <> READYSTATE_COMPLETE
Loop

Application.Run "module1.DeleteSheets"

Dim idoc As MSHTML.HTMLDocument
Set idoc = i.document

idoc.getElementById("Usr").Value = "ID1"
idoc.getElementById("cpny").Value = "ID2"
idoc.getElementById("pwd").Value = "PW"
idoc.getElementsByClassName("btn_primary buttonclass")(0).Click

Do While i.readyState < 4: DoEvents: Loop
Do Until i.readyState = 4: DoEvents: Loop
While i.Busy
DoEvents
Wend
'------------------------------------------------------------------------------
i.navigate ("URL2")

Do While i.readyState < 4: DoEvents: Loop
Do Until i.readyState = 4: DoEvents: Loop
While i.Busy
DoEvents
Wend

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

idoc.getElementById("calendarData").selectedIndex = 4
idoc.getElementById("calendarData").FireEvent ("onchange")

idoc.getElementById("locationData").selectedIndex = 1
idoc.getElementById("locationData").FireEvent ("onchange")

idoc.getElementsByClassName("btn_primary buttonclass")(0).Click

While i.Busy
DoEvents
Wend

ActiveWorkbook.Sheets.Add

i.navigate ("URL 3")

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

HTMLdoc.body.innerHTML = idoc.body.innerHTML
With HTMLdoc.body
Set objTable = .getElementsByTagName("Table")
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
ActiveSheet.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
End With

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Range("a1").Select
ActiveCell.PasteSpecial
ActiveSheet.Name = Range("b2").Value
ActiveWorkbook.Sheets.Add

'---------------------------------------------

Set objTable = Nothing

i.navigate ("URL 4")
While i.Busy
DoEvents
Wend

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

idoc.getElementById("calendarData").selectedIndex = 4
idoc.getElementById("calendarData").FireEvent ("onchange")

idoc.getElementById("locationData").selectedIndex = 2
idoc.getElementById("locationData").FireEvent ("onchange")

idoc.getElementsByClassName("btn_primary buttonclass")(0).Click

While i.Busy
DoEvents
Wend


i.navigate ("URL 5")
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

HTMLdoc.body.innerHTML = idoc.body.innerHTML
With HTMLdoc.body
Set objTable = .getElementsByTagName("Table")
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
ActiveSheet.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
End With

 

[Worf]

Can you post the URL that has the issue?