IE DocumentComplete Event VBA

Hi All,

I have the following code which I've somewhat hurriedly put together to automate some front-end tasks that we perform on a client website. Quite often throughout the code, I'm forced to debug an error and then continue without issue, as clearly the ie.busy & ie.readystate loops are not working. Even when I add manual pauses to the routine, I'm still getting the odd error.

I understand from a small amount of research that the best way to handle this would be via the DocumentComplete event. I have some experience of writing class modules in VBA but I wonder whether anyone has any pre-made code, or could point me towards a suitable online resource?

Thanks in advance.

Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
Public Const BM_CLICK = &HF5

Public Sub IE_Automation(lst As Object)
    Dim IE As SHDocVw.InternetExplorer
    Dim sReportName As String
    Dim bReady As Boolean
    Dim i As Integer, j As Integer
    Dim oCollection As Variant
    Dim hwndIE As Long
    Dim downloadcomplete As Boolean
    Dim FileDownloadHandle As Long, OpenButtonHandle As Long, IePopupBarHandle As Long
    Dim FileDownloadClassicPopup As Boolean

lst.Clear

lst.AddItem "Please wait......"
lst.AddItem ""

    Set IE = New InternetExplorer
    
With IE

    '.Visible = True
    .Navigate "www.example.com"

While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 250

lst.AddItem "Entering login details..."
    
    .Document.getelementbyID("UserName").Value = "UN"
    .Document.getelementbyID("Password").Value = "PW"
    .Document.getelementbyID("Submit").Click
    
While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 3500

    lst.AddItem "LOGIN Successful..."
    lst.AddItem "Setting report parameters..."
 
    .Document.frames(0).Document.getelementbyID("Report").Value = "101"

While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 250

    .Document.frames(0).Document.getelementbyID("Report").fireevent "onchange"

 While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 2500

    .Document.frames(0).Document.getelementbyID("fromDate").Value = Format(Now() - 1, "dd/mm/yyyy")
    .Document.frames(0).Document.getelementbyID("toDate").Value = Format(Now() - 1, "dd/mm/yyyy")
    sReportName = "JRE" & Format(Now(), "ddmmyyyyhhmmss")
    .Document.frames(0).Document.getelementbyID("user_description").Value = sReportName
    .Document.frames(0).Document.getelementbyID("sendreqbutton").Click

While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 250

lst.AddItem "Waiting for report to generate..."

i = 1
    
    Do
    
        If .Document.frames(0).Document.getelementbyID("Desc" & i).Value = sReportName Then
        
            Set oCollection = .Document.frames(0).Document.getelementbyID("row" & i)
            
            If oCollection.Cells(5).innertext = "Completed" Then
                
                .Document.frames(0).Document.getelementbyID("Desc" & i).Click
                bReady = True
                Exit Do
            
            Else
                lst.AddItem "Not done yet. Checking again..."
                .Document.frames(0).Document.parentwindow.execscript ("reloadPage()")
                 While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 2500
                i = 0
            
            End If
            
        End If
        
        i = i + 1
    
    Loop Until bReady
    
    lst.AddItem "Report ready. Downloading..."
    
   Set oCollection = .Document.frames(0).Document.getelementsbyname("downloadtype")
   
    oCollection(0).Value = "2"
   
    Set oCollection = .Document.frames(0).Document.getelementsbyname("downloadbutton")
   
    oCollection(0).Click
    
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 2500

    hwndIE = IE.hWnd

    Do While downloadcomplete = False
             
            IePopupBarHandle = FindWindowEx(hwndIE, 0, "Frame Notification Bar", vbNullString)
            IePopupBarHandle = FindWindowEx(IePopupBarHandle, 0, "DirectUIHWND", vbNullString)
             
            If IePopupBarHandle <> 0 And IE.ReadyState = 4 Then
                downloadcomplete = True
            Else
                FileDownloadHandle = FindWindow("#32770", "File Download")
                If FileDownloadHandle <> 0 Then downloadcomplete = True: FileDownloadClassicPopup = True
            End If
            DoEvents
            Sleep 250
        Loop

        Unload frmMain

        If FileDownloadClassicPopup = True Then
             
            OpenButtonHandle = FindWindowEx(FileDownloadHandle, 0, "Button", "&Open")
            SetForegroundWindow (OpenButtonHandle)
            Sleep 1000
            SendMessage OpenButtonHandle, BM_CLICK, 0, 0
            DoEvents
        Else
            SetForegroundWindow (hwndIE)
            Sleep 1000
            SendKeys "%O", Wait:=True
            DoEvents
        End If

    Set IE = Nothing

    Application.StatusBar = False
    
    .Document.frames(0).Document.parentwindow.execscript ("setFooterCommand('signout'); closing=false;window.status='Logging Out - Please Wait.';top.actionFrame.location.href='/atom/logout.jsp?userid=UN';")
    
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE: DoEvents: Sleep 250: Wend: Sleep 2500
    
    .Quit
    
    
End With

End Sub



 

Open in new window

LVL 12
James ElliottManaging DirectorAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ste5anSenior DeveloperCommented:
Seems you are looking for something like this:

' *** Standard module
Option Explicit

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
Public Const BM_CLICK = &HF5

Public Sub IE_Automation(lst As Object)

  Dim AutomateIE As AutomateIE
  
  Set AutomateIE = New Class1

  AutomateIE.AutomateIE lst

End Sub

Open in new window


with

' *** Class Module named AutomateIE
Option Explicit

Private WithEvents m_InternetExplorer As SHDocVw.InternetExplorer
Private m_List As Object

Public Sub AutomateIE(AList As Object)
    
    Set m_List = AList
    m_List.Clear
    m_List.AddItem "Please wait......"
    m_List.AddItem ""
    
    Set m_InternetExplorer = New SHDocVw.InternetExplorer
    m_InternetExplorer.Navigate "www.example.com"
    
End Sub

Private Sub m_InternetExplorer_DocumentComplete(ByVal pDisp As Object, URL As Variant)

  ' Your other code goes here.

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
James ElliottManaging DirectorAuthor Commented:
Great, thank you. I'll have a play and report back.

Rgds
0
ste5anSenior DeveloperCommented:
btw, line 22 should be Set AutomateIE = New AutomateIE. The first AutomateIE is the variable name and the second is the name of the class (module).
0
James ElliottManaging DirectorAuthor Commented:
Sorry haven't got round to this yet. I have it scheduled for tomorrow.
0
James ElliottManaging DirectorAuthor Commented:
Thanks. Great steer. I'll post my final solution when it's finished, but the above was enough for me to get the general idea.

Regards
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.