Question

我正在尝试使用Excel VBA从IE浏览器下载文件。我正在使用以下三个库来实现完全自动化的过程。

SHDocVw

MSHTML

IUIAutomation

通过填写网页形式的一些信息，可以一一下载三个文件。每个文件都有不同的文件大小。

我需要一种动态等待机制，该机制可使程序保持暂停状态，直到IE浏览器底部出现OPEN / SAVE / CANCEL迷你窗口。

要在IE浏览器上检测到一个迷你窗口，我使用FindWindowEx函数调用API以获取窗口是否到达。

这是执行动态等待的代码。

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

以上代码适用于第一个文件，但是当代码开始准备第二个文件以供下载时，它不会等到迷你窗口出现。

我在调试时注意到，“保留值”保持不变。因此，FindWindowEx(Ret, ByVal 0&, "Frame Notification Bar", vbNullString)认为对话框已出现但没有出现。

它一直运行，而无需等到迷你窗口出现。我下载了第一个文件，其余两个文件都丢失了。

这是导出按钮的元素。

<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>

我正在发布整个模块，但是上面的代码才是关键。

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

等待IE浏览器中出现OPEN / SAVE / CANCEL迷你窗口。 FindWindowEx（）无法通过VBA中的IE循环

0 个答案: