VBA-IE refresh if not ready

[flaviu123]

Hi everyone!
Use the following a code to automatically open approx 5,000 links and frequently IE remains busy, thereby blocking the process.

Sub GetTable()
   
    Dim ieApp As InternetExplorer
    Dim ieDoc As Object
    Dim ieTable As Object
    Dim clip As DataObject
   
    'create a new instance of ie
    Set ieApp = New InternetExplorer
   
    'you don’t need this, but it’s good for debugging
    ieApp.Visible = True
   
    'assume we’re not logged in and just go directly to the login page
    vAddr = ActiveCell.Hyperlinks(1).Address
    ieApp.Navigate vAddr
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
'copiaza continutul paginii
    Application.CutCopyMode = False
    ieApp.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    ieApp.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
       
        Sheets("Sheet2").Select
        With ActiveSheet
        LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        End With
        
        h = LastCol + 1
        Cells(1, h).Select
        ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False
        Sheets("Sheet1").Select
   
    'close 'er up
    ieApp.Quit
    Set ieApp = Nothing
   
End Sub

I'm interested in a code that give refresh after 10 seconds if IE is not ready.


All the best!

 

[BiocideJ]

I believe this is what you are looking for.
I combined both of the Busy/READY_STATE loops into a single loop and inside of that placed a condition to check if the loop has been running for >10 seconds and if so to refresh the page and reset the timer.

Sub GetTable()
   
    Dim ieApp As InternetExplorer
    Dim ieDoc As Object
    Dim ieTable As Object
    Dim clip As DataObject
   
    'create a new instance of ie
    Set ieApp = New InternetExplorer
   
    'you don’t need this, but it’s good for debugging
    ieApp.Visible = True
   
    'assume we’re not logged in and just go directly to the login page
    vAddr = ActiveCell.Hyperlinks(1).Address
    ieApp.Navigate vAddr
    StartTIMER = Timer
    Do While ieApp.Busy And ieApp.ReadyState <> READYSTATE_COMPLETE
        DoEvents
        If StartTIMER + 10 > Timer Then
            ieApp.Refresh
            StartTIMER = Timer  'reset timer for refresh (so it doesn't refresh continuously)
        End If
    Loop
'copiaza continutul paginii
    Application.CutCopyMode = False
    ieApp.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    ieApp.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
       
        Sheets("Sheet2").Select
        With ActiveSheet
        LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        End With
        
        h = LastCol + 1
        Cells(1, h).Select
        ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False
        Sheets("Sheet1").Select
   
    'close 'er up
    ieApp.Quit
    Set ieApp = Nothing
   
End Sub

 

[flaviu123]

Thanks for your help!
I tryed your code and it blocks at ieApp.Refresh and shows me the error: Run-time error '-2147467259 (80004005)'
Automation error
Unspecified error

 

[BiocideJ]

Is the opened instance of IE still open and responsive?

If so, that is odd, because when I test this on a generic website such as google, it seems to work. (note I am forcing it to not wait the 10 secs)

 

[flaviu123]

yes, is an instance of IE open, but must remain open in order to stay logged into the site where the exported data
sorry for english

 

[BiocideJ]

I am not sure why that wouldn't work.

instead of ieApp.Refresh maybe just navigate to the page again...

ieApp.Navigate vAddr

 

[flaviu123]

Yes, it's a good idea. I will try with next 5000 links to the next project. Thank you!