VBA按IE弹出菜单中的“保存”

Question

问题： 我找不到操纵以下内容的方法，即下载弹出窗口。

我尝试使用下面的代码，但这不是框架通知栏，因此没有帮助。

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

有人知道如何在不使用发送键的情况下操纵此弹出窗口吗？

Answer 1

大约一年前，我遇到了类似的问题，可以通过实施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

使用FindWindow API，我实现了一种监视程序

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，后者只是将指定的击键发送到焦点所在的任何地方。

Answer 2

泰特·加林格（Tate Garringer）的答案具有正确的逻辑，但由于某些原因对我不起作用。我最终在以下位置找到了行之有效的信息以及大量有用的信息： 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

希望这对其他人有帮助