VBA: как ждать всплывающие окна с помощью IE - PullRequest
Новая
       16

VBA: как ждать всплывающие окна с помощью IE

1 голос
/ 23 октября 2019

Вообще, как проще всего ждать появления всплывающего окна в VBA с помощью автоматизации IE? Я написал программу с помощью этого сообщества, которая была очень информативной, каждый раз, когда я сталкивался с препятствиями в своем коде. Спасибо, милостиво.

Ситуация:

Я создаю программу, которая взаимодействует с IE. Это процесс автоматизации, который обрабатывает данные на основе функциональности сайта. В процессе автоматизации, когда я нажимаю на ссылку, открывается всплывающее окно. Вот где проблемы. Иногда для загрузки всплывающего окна требуется от 5 до 30 секунд. Тем не менее, я не могу определить продолжительность времени, которое требуется для загрузки всплывающего окна, равно как и программа, которая аварийно завершает работу каждый раз, когда выходит за пределы периода ожидания, который я установил в программе.

Все остальное работает отлично, за исключением этого небольшого небольшого удаления, которое является окончательной смертью моей программы и направляет ее по спирали вниз.

Всплывающее окно должно сначала загрузиться, прежде чем я смогу назначить объект popWindow (IE). 

 Dim popWindow As InternetExplorer 
 Set popWindow = oGetIEWindowFromTitle("Site Name")
 Set deviceWindow = popWindow.Document

Function oGetIEWindowFromTitle(sTitle As String, _
                               Optional bCaseSensitive As Boolean = False, _
                               Optional bExact As Boolean = False) As Shdocvw.InternetExplorer

    Dim objShellWindows As New Shdocvw.ShellWindows
    Dim found As Boolean
    Dim startTime As Single

    found = False
    'Loop through shell windows
    For Each oGetIEWindowFromTitle In objShellWindows
        found = oGetIEWindowFromTitleHandler(oGetIEWindowFromTitle, sTitle, bCaseSensitive, bExact)
        If found Then Exit For
    Next

    'Check whether a window was found
    If Not found Then
        Set oGetIEWindowFromTitle = Nothing
    Else




        Do While oGetIEWindowFromTitle.Busy '----- this is what I have tried
        Application.Wait (Now + TimeValue("00:00:01"))
        Loop


        Do While oGetIEWindowFromTitle.Busy = True Or oGetIEWindowFromTitle.ReadyState <> 4: DoEvents: Loop '------ this is what I have tried




    End If

End Function

Private Function oGetIEWindowFromTitleHandler(win As Shdocvw.InternetExplorer, _
                                      sTitle As String, _
                                      bCaseSensitive As Boolean, _
                                      bExact As Boolean) As Boolean

    oGetIEWindowFromTitleHandler = False

    On Error GoTo handler
    'If the document is of type HTMLDocument, it is an IE window
    If TypeName(win.Document) = "HTMLDocument" Then
        'Check whether the title contains the passed title
        If bExact Then
            If (win.Document.Title = sTitle) Or ((Not bCaseSensitive) And (LCase(sTitle) = LCase(win.Document.Title))) Then oGetIEWindowFromTitleHandler = True
        Else
            If InStr(1, win.Document.Title, sTitle) Or ((Not bCaseSensitive) And (InStr(1, LCase(win.Document.Title), LCase(sTitle), vbTextCompare) <> 0)) Then oGetIEWindowFromTitleHandler = True
        End If
    End If
handler:
    'We assume here that if an error is raised it's because
    'the window is not of the correct type. Therefore we
    'simply ignore it and carry on.

End Function

1 Ответ

1 голос
/ 24 октября 2019

Вот один из способов сделать это: 

Sub Tester()

    Dim w As Object, t

    t = Timer
    Set w = WaitForWindow("google.com", 10)

    If Not w Is Nothing Then
        Debug.Print "Found in " & Timer - t
    Else
        Debug.Print "Not found after " & Timer - t
    End If

End Sub

'Find (or wait for) an IE window with location
'   matching URL (using "Like" for matching)
'Try for maxWait seconds then give up
Function WaitForWindow(URL As String, maxWait As Long)
    Dim rv As Object, t
    t = Timer
    Do While Timer - t < maxWait
        Set rv = GetIEByUrl(URL)
        If Not rv Is Nothing Then Exit Do
        Application.Wait (Now + TimeValue("00:00:01"))
    Loop
    Set WaitForWindow = rv
End Function

'Try to get an existing IE window based on URL match
Function GetIEByUrl(URL As String) As Object
    Dim o As Object, rv As Object
    For Each o In CreateObject("Shell.Application").Windows
        If TypeName(o) = "IWebBrowser2" Then
            If o.Locationurl Like "*" & URL & "*" Then
                Set rv = o
                Exit For
            End If
        End If
    Next o
    Set GetIEByUrl = rv
End Function
...