Increase speed to extract data

[Anantha Krishna]

Hello Team,

Kindly help me to increase speed on getting data from webpage , currently i am using below code but it is taking too much time.

* * * * * start to use code - tags * * * * *
as written in Forum Rules
​

***
Sub newGrabLastNames()

    'dimension (set aside memory for) our variables
    Dim HTMLDoc As New HTMLDocument
    Dim objIE As InternetExplorer
    Dim ele As Object
    Dim y As Integer
      Dim lngTable As Long
    Dim LngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long

   
    'start a new browser instance
    Set objIE = New InternetExplorerMedium
    'make browser visible
    objIE.Visible = True
   

    'navigate to page with needed data
    objIE.Navigate "https://xxxxx.com"
    'wait for page to load
    Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
    
Application.Wait Now + TimeSerial(0, 0, 10)
Set objcollection = objIE.Document.getElementsByTagName("img")
   
   i = 0
    While i < objcollection.Length
        If objcollection(i).Name = "imgclaimItemInformation" Then

            objcollection(i).Click
            End If
   
i = i + 1
    Wend
   
Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
Application.Wait Now + TimeSerial(0, 0, 25)
HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
Set objTable = objIE.Document.getElementById("claimItemInformationDiv"). _
      getElementsByTagName("tbody")
        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
                    ThisWorkbook.Sheets("Sheet2").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

    'save the Excel workbook
    ActiveWorkbook.Save

End Sub***

Thanks in Advance,
Anantha Krishna

 

[Anantha Krishna]

Below is code which using currently.

Sub newGrabLastNames()

    'dimension (set aside memory for) our variables
    Dim HTMLDoc As New HTMLDocument
    Dim objIE As InternetExplorer
    Dim ele As Object
    Dim y As Integer
      Dim lngTable As Long
    Dim LngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long

   
    'start a new browser instance
    Set objIE = New InternetExplorerMedium
    'make browser visible
    objIE.Visible = True
   

    'navigate to page with needed data
    objIE.Navigate "https://xxxxx.com"
    'wait for page to load
    Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
    
Application.Wait Now + TimeSerial(0, 0, 10)
Set objcollection = objIE.Document.getElementsByTagName("img")
   
   i = 0
    While i < objcollection.Length
        If objcollection(i).Name = "imgclaimItemInformation" Then

            objcollection(i).Click
            End If
   
i = i + 1
    Wend
   
Do While objIE.Busy = True Or objIE.ReadyState <> 4: DoEvents: Loop
Application.Wait Now + TimeSerial(0, 0, 25)
HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
Set objTable = objIE.Document.getElementById("claimItemInformationDiv"). _
      getElementsByTagName("tbody")
        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
                    ThisWorkbook.Sheets("Sheet2").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

    'save the Excel workbook
    ActiveWorkbook.Save

End Sub