Excel VBA pull website data

Question

I want to pull any data from website "http://result.biselahore.com/" to Excel Sheet by entering roll number "217449". After entering Roll Number it goes to the result card page with detail subject wise marks.

To get subject-wise marks from the next page and paste it on excel, the following code is not working and it gives error number 91, "Object variable With block variable not set".

Here is my entire code:

Sub WData()

Do Until ActiveCell.Value = "100000"

Dim IE As New InternetExplorer

Dim DOCS As HTMLDocument

Dim str, str1, str2, str3, str4, str5 As String

IE.navigate "http://result.biselahore.com/"

IE.Visible = True

Do

DoEvents

Loop Until IE.readyState = READYSTATE_COMPLETE

IE.document.getElementById("rollNum").Value = ActiveCell.Value

IE.document.forms(0).submit

Do While IE.Busy

DoEvents

Loop

Set DOCS = IE.document

Do While DOCS.readyState <> "complete"

DoEvents

Loop

str = IE.document.getElementsByTagName("td")(4).innerText

str1 = IE.document.getElementsByTagName("td")(7).innerText

str2 = IE.document.getElementsByTagName("td")(9).innerText

str3 = IE.document.getElementsByTagName("td")(20).innerText

str4 = IE.document.getElementsByTagName("td")(23).innerText

str5 = IE.document.getElementsByTagName("td")(25).innerText

str6 = IE.document.getElementsByTagName("td")(27).innerText

str7 = IE.document.getElementsByTagName("td")(37).innerText

str8 = IE.document.getElementsByTagName("td")(38).innerText

str9 = IE.document.getElementsByTagName("td")(42).innerText

str10 = IE.document.getElementsByTagName("td")(43).innerText

str11 = IE.document.getElementsByTagName("td")(47).innerText

str12 = IE.document.getElementsByTagName("td")(48).innerText

str13 = IE.document.getElementsByTagName("td")(52).innerText

str14 = IE.document.getElementsByTagName("td")(53).innerText

str15 = IE.document.getElementsByTagName("td")(57).innerText

str16 = IE.document.getElementsByTagName("td")(58).innerText

str17 = IE.document.getElementsByTagName("td")(62).innerText

str18 = IE.document.getElementsByTagName("td")(63).innerText

str19 = IE.document.getElementsByTagName("td")(71).innerText

Dim lastrow As Integer

lastrow = Worksheets(1).Range("b" & Worksheets(1).Rows.Count).End(xlUp).Row + 1

Cells(lastrow, 2).Value = Trim(str)

Cells(lastrow, 3).Value = Trim(str1)

Cells(lastrow, 4).Value = Trim(str2)

Cells(lastrow, 5).Value = Trim(str3)

Cells(lastrow, 6).Value = Trim(str4)

Cells(lastrow, 7).Value = Trim(str5)

Cells(lastrow, 8).Value = Trim(str6)

Cells(lastrow, 9).Value = Trim(str7)

Cells(lastrow, 10).Value = Trim(str8)

Cells(lastrow, 11).Value = Trim(str9)

Cells(lastrow, 12).Value = Trim(str10)

Cells(lastrow, 13).Value = Trim(str11)

Cells(lastrow, 14).Value = Trim(str12)

Cells(lastrow, 15).Value = Trim(str13)

Cells(lastrow, 16).Value = Trim(str14)

Cells(lastrow, 17).Value = Trim(str15)

Cells(lastrow, 18).Value = Trim(str16)

Cells(lastrow, 19).Value = Trim(str17)

Cells(lastrow, 20).Value = Trim(str18)

Cells(lastrow, 21).Value = Trim(str19)

IE.Quit

Set IE = Nothing

Selection.Offset(1, 0).Select

Loop

End Sub

My Desired OUTPUT:

Subject Marks   Subject    Marks    Subject     Marks  Subject     Marks

URDU    68  62  ENGLISH     75  70  ISLAMIAT    50 49 MATHEMATICS   75 75 

PHYSICS 60  59  CHEMISTRY   60  60  BIOLOGY     58 59

QHarr QHarr · Accepted Answer · 2018-07-27T12:33:50

The web "table" is a mess tbh. I am skipping the 2 headers which have "merged cells".

I have added a loop check until table set with time-out function by @PeterAlbert, to exit the loop after a set time, to stop infinite loop.

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, html As HTMLDocument, hTable As Object, ele As Object
    With IE
        .Visible = True
        .navigate "http://result.biselahore.com/"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.querySelector("#rollNum").innerText = 217449
        .document.forms(0).submit
        Dim dblStart As Double
        Dim tmp As Long

        Const cDblMaxTimeInSeconds As Double = 5 '<==Second to wait until timeout

        dblStart = Timer

        While .Busy Or .readyState < 4: DoEvents: Wend
        Do
            DoEvents
            On Error Resume Next
            Set hTable = .document.getElementsByTagName("table")(1)
            On Error GoTo 0
            If TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds Then Exit Do
        Loop While hTable Is Nothing
        Dim list As Object, list2 As Object
        Set list = hTable.getElementsByTagName("tr")
        Dim i As Long, j As Long, r As Long, c As Long
        Application.ScreenUpdating = False
        For i = 13 To list.Length - 1
            Set list2 = list.item(i).getElementsByTagName("td")
            r = r + 1: c = 0
            For j = 0 To list2.Length - 1
                c = c + 1
                Cells(r, c) = list2.item(j).innerText
            Next j
        Next i
        Application.ScreenUpdating = True
    End With
End Sub

Public Function TimerDiff(ByVal dblTimerStart As Double, ByVal dblTimerEnd As Double) As Double
    Dim dblTemp As Double
    dblTemp = dblTimerEnd - dblTimerStart
    If dblTemp < -43200 Then 'half a day
        dblTemp = dblTemp + 86400
    End If
    TimerDiff = dblTemp
End Function

Version 2 (using timer function from above)

Public Sub GetInfo()
    Dim IE As New InternetExplorer, html As HTMLDocument, hTable As Object, ele As Object
    With IE
        .Visible = True
        .navigate "http://result.biselahore.com/"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.querySelector("#rollNum").innerText = 217449
        .document.forms(0).submit
        Dim dblStart As Double, tmp As Long, clipboard As Object

        Const cDblMaxTimeInSeconds As Double = 5 '<==Second to wait until timeout

        dblStart = Timer

        While .Busy Or .readyState < 4: DoEvents: Wend
        Do
            DoEvents
            On Error Resume Next
            Set hTable = .document.getElementsByTagName("table")(1)
            On Error GoTo 0
            If TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds Then Exit Do
        Loop While hTable Is Nothing

        Application.ScreenUpdating = False
        Set clipboard = New MSForms.DataObject
        clipboard.SetText hTable.outerHTML
        clipboard.PutInClipboard
        ActiveSheet.Cells(1, 1).PasteSpecial
        Application.ScreenUpdating = True
    End With
End Sub

Excel VBA pull website data

1 Answers