Solved

IE DocumentComplete Event VBA

Posted on 2014-09-25
5
875 Views
Last Modified: 2014-09-29
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
Comment
Question by:James Elliott
  • 3
  • 2
5 Comments
 
LVL 32

Accepted Solution

by:
ste5an earned 500 total points
ID: 40343569
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
 
LVL 12

Author Comment

by:James Elliott
ID: 40343585
Great, thank you. I'll have a play and report back.

Rgds
0
 
LVL 32

Expert Comment

by:ste5an
ID: 40343772
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
 
LVL 12

Author Comment

by:James Elliott
ID: 40348753
Sorry haven't got round to this yet. I have it scheduled for tomorrow.
0
 
LVL 12

Author Closing Comment

by:James Elliott
ID: 40349463
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

Are end users causing IT problems again?

You’ve taken the time to design and update all your end user’s email signatures, only to find out they’re messing up the HTML, changing the font and ruining the imagery. What can you do to prevent this? Find out how you can save your signatures from end users today.

Join & Write a Comment

How can MDaemon MRK files and MSG files work together? We can also say that, how worldclient and Outlook connecter works, using both application collectively you can view your mails, contacts, calendar, task, notes. In this article you can unders…
Being able to change email signatures is made really simple with email signature software and services.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now