Question

Я пытаюсь загрузить файлы из браузера IE с помощью Excel VBA.Я использую следующие три библиотеки для полной автоматизации процесса:

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

Вышеупомянутый код работал для первого файла, но когда код начинает подготовку второго файла для загрузки, он не ждет, покаПоявится мини-окно.

Я заметил, что при отладке значение Ret остается неизменным.Из-за этого 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 () не работает при цикле через IE в VBA

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 0 ]

Подождите, пока в браузере IE не появится мини-окно OPEN / SAVE / CANCEL.FindWindowEx () не работает при цикле через IE в VBA

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 0 ]

Нет похожих вопросов