I'm trying to download files from the IE browser with Excel VBA. I'm using the following three libraries to drive process in complete automation.
- SHDocVw
- MSHTML
- IUIAutomation
There are three files to download one by one by filling some information on the form of the webpage. Each file has a different file size.
I require a dynamic wait mechanism which keeps my program on hold until OPEN/SAVE/CANCEL mini window appears in the bottom of the IE browser.
To detect a mini window on the IE browser, I used FindWindowEx Function to call an API to get whether the window has arrived.
Here is the code to perform the dynamic wait.
Private Sub WaitTillFrame(ByVal oBrowser As SHDocVw.InternetExplorer)
Dim heWnd As LongPtr
Dim Ret As LongPtr
Do Until heWnd > 0
Ret = oBrowser.hWnd
heWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)
DoEvents
Loop
End Sub
Above code worked for the first file but when code starts preparation of the second file for download it doesn't wait until the mini window appears.
I have noticed while debugging, Ret Value remains unchanged. Because of that FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString) thinks the dialogue box has appeared but it has not.
It keeps running, without waiting until the mini window appears. I download the first file and remaining two files are missed.
Here is element of the export button.
<button title="Export" class="x7g" style="background-image:url(/xmlpserver/cabo/images/swan/btn-bg1.gif)" onclick="return exportReport('xdoRptForm', '/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/Stock Available For Upload Transfer/Stock Available For Upload Transfer.xdo');" type="button">Export</button>
I'm posting my whole module but the code above is the key.
Option Explicit
#If VBA7 Then
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
Public Const BM_CLICK = &HF5
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Sub UPL_Reports_Automation()
Dim IE As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim A, B, C, D, E, F, G, H As MSHTML.IHTMLElement
Dim I As Long
Dim TargetFolder As String
Dim FileName As String
Dim FName As String
Application.ScreenUpdating = False
On Error GoTo EhhError
Application.ActiveWindow.WindowState = xlMinimized
'Login Screen
TargetFolder = "D:\TestingDownloaing"
Set IE = New SHDocVw.InternetExplorerMedium
'Navigate to the Login Page
IE.navigate "http://10.110.10.78:9704/xmlpserver/login.jsp"
IE.Visible = True
WaitLa 5
Do While IE.readyState <> READYSTATE_COMPLETE: DoEvents: Loop
Set HTMLDoc = IE.document
'To check if the Login page is there or not ?
Set D = HTMLDoc.getElementsByClassName("xy")(1)
'Bypassing the element if the login page is visible.
If Not D Is Nothing Then
D.Click
WaitLa 5
Do While IE.readyState <> READYSTATE_COMPLETE: DoEvents: Loop
Set HTMLDoc = Nothing
Set HTMLDoc = IE.document
End If
'Enter Login ID
Set A = HTMLDoc.getElementById("id")
A.Value = "merchandiser"
'Enter Password
Set B = HTMLDoc.getElementById("passwd")
B.Value = "merchandiser"
'Click on Login Button
Set C = HTMLDoc.getElementsByClassName("submitButtonEnable")(0)
WaitLa 2
C.Click
Do While IE.readyState <> READYSTATE_COMPLETE: DoEvents: Loop
'Part 2 Navigate to UPL Page
IE.navigate "http://10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/Stock%20Available%20For%20Upload%20Transfer/Stock%20Available%20For%20Upload%20Transfer.xdo"
Do While IE.readyState <> READYSTATE_COMPLETE: DoEvents: Loop
WaitLa 5
Set HTMLDoc = Nothing
Set HTMLDoc = IE.document
'Select Template Format
Set G = HTMLDoc.getElementById("_xf")
G.selectedIndex = 1
FName = vbNullString
FileName = vbNullString
'Download Territory wise files
For I = 1 To 3 Step 1
Select Case I
Case 1
'UAE
Set F = HTMLDoc.getElementById("terr")
F.selectedIndex = 9
IE.document.getElementById("terr").FireEvent ("onchange")
FName = "UPL-UAE"
WaitLa 9
Case 2
'RIYADH
Set F = HTMLDoc.getElementById("terr")
F.selectedIndex = 8
IE.document.getElementById("terr").FireEvent ("onchange")
FName = "UPL-KSA-RIYADH"
WaitLa 9
Case 3
'BAHRAIN
Set F = HTMLDoc.getElementById("terr")
F.selectedIndex = 1
IE.document.getElementById("terr").FireEvent ("onchange")
FName = "UPL-BAH"
WaitLa 9
End Select
'Creating a File Name
FileName = TargetFolder & "\" & FName & ".txt"
'Click on Export Button
Set H = HTMLDoc.getElementsByClassName("x7g")(1)
H.Click
Call WaitTillFrame(IE)
'Automation to Download File
Call Download(IE, FileName, True)
Next I
IE.Quit
ClosedIt:
Set HTMLDoc = Nothing
Set A = Nothing
Set B = Nothing
Set C = Nothing
Set D = Nothing
Set E = Nothing
Set F = Nothing
Set G = Nothing
Set H = Nothing
Set IE = Nothing
Application.ScreenUpdating = True
Application.ActiveWindow.WindowState = xlMaximized
Exit Sub
EhhError:
If Err.Number <> 0 Then
MsgBox Err.Number & vbNewLine & vbNewLine & Err.Description & vbNewLine & vbNewLine & "Last File Downloaded : " & FName, vbCritical, "Error Reporting'"
Resume ClosedIt
End If
End Sub
Private Sub WaitTillFrame(ByVal oBrowser As SHDocVw.InternetExplorer)
Dim heWnd As LongPtr
Dim Ret As LongPtr
Do Until heWnd > 0
Ret = oBrowser.hWnd
heWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)
DoEvents
Loop
End Sub
Sub WaitLa(ByVal Seconds As Byte)
If VBA.Val(Seconds) <= 9 Then
Call Application.Wait(VBA.Time + VBA.TimeValue("00:00:0" & VBA.Val(Seconds)))
End If
End Sub
