[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1372
  • Last Modified:

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

0
James Elliott
Asked:
James Elliott
  • 3
  • 2
1 Solution
 
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
 
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

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now