Mixing
FindWindowEx() is Failing on Looping through IE in VBA
2
Such a challanging day today!
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 I need to download one by one by filling some information on the form of the webpage. And Each file has a different file size.
So Definitely, I would require a dynamic wait mechanism which keeps my program on hold until OPEN/SAVE/CANCEL mini window appeared in the bottom of the IE browser.
To Detect above a mini window on the IE browser, I used FindWindowEx Function to call an API to get whether the window has arrived or not.
Here is the Code I used 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 fine for the First File...but when code start preparation of the second file for download it doesn't work until above Mini window appeared.
I have noticed while debugging, Ret Value keep remain unchanged so because of that "FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)" the particular line thinks the dialogue box has appeared but unfortunately it's not.
So It keeps running code without waiting until the mini window appeared. So in the end, I'm only able to download the first file and remaining two files will be 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 also posting my whole module here so but the above-pasted code 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
Thank you.
excel vba excel-vba
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
add a comment |
2
Such a challanging day today!
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 I need to download one by one by filling some information on the form of the webpage. And Each file has a different file size.
So Definitely, I would require a dynamic wait mechanism which keeps my program on hold until OPEN/SAVE/CANCEL mini window appeared in the bottom of the IE browser.
To Detect above a mini window on the IE browser, I used FindWindowEx Function to call an API to get whether the window has arrived or not.
Here is the Code I used 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 fine for the First File...but when code start preparation of the second file for download it doesn't work until above Mini window appeared.
I have noticed while debugging, Ret Value keep remain unchanged so because of that "FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)" the particular line thinks the dialogue box has appeared but unfortunately it's not.
So It keeps running code without waiting until the mini window appeared. So in the end, I'm only able to download the first file and remaining two files will be 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 also posting my whole module here so but the above-pasted code 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
Thank you.
excel vba excel-vba
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
Ret will always have the same value. The value ofheWndshould change. Put a break on the lineheWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)and check the value of it realtime
– Siddharth Rout
Jan 3 at 5:17
Also you have anExportbutton? Does it point to a specific download link? If yes then you can also try usingURLDownloadToFileAPI
– Siddharth Rout
Jan 3 at 5:24
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52
add a comment |
2
2
2
Such a challanging day today!
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 I need to download one by one by filling some information on the form of the webpage. And Each file has a different file size.
So Definitely, I would require a dynamic wait mechanism which keeps my program on hold until OPEN/SAVE/CANCEL mini window appeared in the bottom of the IE browser.
To Detect above a mini window on the IE browser, I used FindWindowEx Function to call an API to get whether the window has arrived or not.
Here is the Code I used 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 fine for the First File...but when code start preparation of the second file for download it doesn't work until above Mini window appeared.
I have noticed while debugging, Ret Value keep remain unchanged so because of that "FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)" the particular line thinks the dialogue box has appeared but unfortunately it's not.
So It keeps running code without waiting until the mini window appeared. So in the end, I'm only able to download the first file and remaining two files will be 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 also posting my whole module here so but the above-pasted code 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
Thank you.
excel vba excel-vba
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
Such a challanging day today!
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 I need to download one by one by filling some information on the form of the webpage. And Each file has a different file size.
So Definitely, I would require a dynamic wait mechanism which keeps my program on hold until OPEN/SAVE/CANCEL mini window appeared in the bottom of the IE browser.
To Detect above a mini window on the IE browser, I used FindWindowEx Function to call an API to get whether the window has arrived or not.
Here is the Code I used 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 fine for the First File...but when code start preparation of the second file for download it doesn't work until above Mini window appeared.
I have noticed while debugging, Ret Value keep remain unchanged so because of that "FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)" the particular line thinks the dialogue box has appeared but unfortunately it's not.
So It keeps running code without waiting until the mini window appeared. So in the end, I'm only able to download the first file and remaining two files will be 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 also posting my whole module here so but the above-pasted code 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
Thank you.
excel vba excel-vba
excel vba excel-vba
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
edited Jan 7 at 8:49
Pᴇʜ
24.6k63052
24.6k63052
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
asked Jan 2 at 15:01
Kamal BharakhdaKamal Bharakhda
489
489
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
Ret will always have the same value. The value ofheWndshould change. Put a break on the lineheWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)and check the value of it realtime
– Siddharth Rout
Jan 3 at 5:17
Also you have anExportbutton? Does it point to a specific download link? If yes then you can also try usingURLDownloadToFileAPI
– Siddharth Rout
Jan 3 at 5:24
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52
add a comment |
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
Ret will always have the same value. The value ofheWndshould change. Put a break on the lineheWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)and check the value of it realtime
– Siddharth Rout
Jan 3 at 5:17
Also you have anExportbutton? Does it point to a specific download link? If yes then you can also try usingURLDownloadToFileAPI
– Siddharth Rout
Jan 3 at 5:24
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
Ret will always have the same value. The value of
heWnd should change. Put a break on the line heWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString) and check the value of it realtime– Siddharth Rout
Jan 3 at 5:17
Ret will always have the same value. The value of
heWnd should change. Put a break on the line heWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString) and check the value of it realtime– Siddharth Rout
Jan 3 at 5:17
Also you have an
Export button? Does it point to a specific download link? If yes then you can also try using URLDownloadToFile API– Siddharth Rout
Jan 3 at 5:24
Also you have an
Export button? Does it point to a specific download link? If yes then you can also try using URLDownloadToFile API– Siddharth Rout
Jan 3 at 5:24
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f54008573%2ffindwindowex-is-failing-on-looping-through-ie-in-vba%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
draft saved
draft discarded
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f54008573%2ffindwindowex-is-failing-on-looping-through-ie-in-vba%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Have you seen THIS
– Siddharth Rout
Jan 2 at 17:06
@SiddharthRout Yes, Sir, I went through it earlier and many threads. Actually, if you look at the code, it builds on the same concept. It worked for me on the single download but when I create a loop to download documents one by one by filling the form, the code stops working. I found, the RET value in the first download was 0 but when loop triggers the second download, RET has it's earlier value, so the FindWindowEx captured that value and without getting the save as dialogue, it skips to the third download. and the same happens with the third too. any idea?
– Kamal Bharakhda
Jan 2 at 18:04
Ret will always have the same value. The value of
heWndshould change. Put a break on the lineheWnd = FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)and check the value of it realtime– Siddharth Rout
Jan 3 at 5:17
Also you have an
Exportbutton? Does it point to a specific download link? If yes then you can also try usingURLDownloadToFileAPI– Siddharth Rout
Jan 3 at 5:24
@SiddharthRout : here is the link of the Page... 10.110.10.78:9704/xmlpserver/ECOM_RDC/MERCHANDISING/SOH_Report/… Here is the 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>
– Kamal Bharakhda
Jan 3 at 8:52