VBA нажать кнопку Сохранить из IE Popup - PullRequest
0 голосов
/ 10 января 2019

Проблема: Я не могу найти способ манипулировать ниже, т.е. загрузить всплывающее окно.

pic

Я пытался использовать приведенный ниже код, но это не панель уведомлений о фреймах, поэтому она не помогает.

Sub PressSave(ie As InternetExplorer)
    Dim o As IUIAutomation
    Dim e As IUIAutomationElement
    Application.Wait (Now + TimeSerial(0, 0, 4))
    Set o = New CUIAutomation
    Dim h As Long
    h = ie.hwnd
    'find notification bar
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    If h = 0 Then Exit Sub

    'find save button
    Set e = o.ElementFromHandle(ByVal h)
    Dim iCnd As IUIAutomationCondition
    Dim Button As IUIAutomationElement
    Do Until Not Button Is Nothing
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
    Loop

    'click save
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

    'wait till file is completely downloaded
    Dim iOpen As IUIAutomationCondition
    Dim OpenButton As IUIAutomationElement
    Do Until Not OpenButton Is Nothing
    Set iOpen = o.CreatePropertyCondition(UIA_NamePropertyId, "View 
downloads")
    Set OpenButton = e.FindFirst(TreeScope_Subtree, iOpen)
    Loop
End Sub

Я также пытался использовать API для получения данных, но получал ошибку 401, что означает, что требуется аутентификация, и я не уверен, что могу добавить аргументы для этого.

Sub APIToGetData()
Dim sURL As String
Dim savePath As String
Dim WinHttpReq As Object

savePath = "C:\Downloads"
sURL = "https://[myurlhere]/api/admin/data_dumps/download"
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")

WinHttpReq.Open "GET", sURL, False
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.Close
End If
End Sub

Кто-нибудь знает, как управлять этим всплывающим окном без использования клавиш отправки?

Ответы [ 2 ]

0 голосов
/ 16 февраля 2019

Ответ Тейт Гаррингер имеет правильную логику, но по какой-то причине у меня не сработало. Я нашел то, что сработало, а также кучу полезной информации по адресу: https://www.mrexcel.com/forum/excel-questions/502298-need-help-regarding-ie-automation-using-vba-3.html

Ниже приведен прямой ответ на мой вопрос:

'Find the Save As window, waiting a maximum of 10 seconds for it to appear
timeout = Now + TimeValue("00:00:10")
Do
    hwnd = FindWindow("#32770", "Save As")
    DoEvents
    Sleep 300
Loop Until hwnd Or Now > timeout

Надеюсь, это поможет кому-то еще

0 голосов
/ 10 января 2019

Год назад или около того у меня была похожая проблема, которую я смог решить с помощью API

.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

И

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Integer, ByVal wParam As Long, ByVal lParam As Long) As Long

Используя API FindWindow, я реализовал своего рода процедуру наблюдения

Do Until FindWindow(vbNullString, "Internet Explorer") > 0
    Sleep 100
    DoEvents
Loop

Как только оно нашло окно, я должен был подтвердить выбор по умолчанию (в моем случае это было "Открыть"), пока окно не исчезло

Do Until FindWindow(vbNullString, "Internet Explorer") = 0
    SendMessage FindWindow(vbNullString, "Internet Explorer"), WM_COMMAND, IDOK, 0
    Sleep 100
    DoEvents
Loop

SendMessage великолепен, потому что он отправляет команду непосредственно целевому hWnd по сравнению с SendKeys, который просто отправляет указанное нажатие клавиши тому, что находится в фокусе.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...