按保存按钮 IE 通过自定义功能下载提示

Question

除了最后点击下载提示中的“保存”按钮外，我已经设法从我的子程序中删除所有发送密钥以从 IE 中提取电子表格。我知道有很多关于这个的帖子，我都读过了，但今天我发现了一个看起来很棒的功能，但我似乎无法适应 it/get 它的工作。

注意：这不是 URL 我可以调用 w/Params，但我在页面上输入信息并点击按钮 Excel，然后返回电子表格的下载提示。

我也不确定下面的代码是为了运行在“下载”完整 window (CTRL + J) 还是底部的提示栏上，但我都没有运气就试过了。如果需要，我可以打开“完整的 window”，但它需要我希望消除的 sendkeys，但目前代码自然只在 window 底部显示下载“栏” .

这里有一些 links:

Excel VBA to Save As from IE 11 Download Bar

https://www.mrexcel.com/board/threads/need-help-regarding-ie-automation-using-vba.502298/page-2

到目前为止，这是我的代码，其中有两个变体 link:

函数（独立模块）

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Private Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare Function CloseClipboard Lib "user32" () As Long
      Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Private Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If
Public IEObj As Object
Public Sub Activate_A_Window(WindowName As String)
    Dim IE As Object
    Dim Windows As Object: Set Windows = CreateObject("Shell.Application").Windows
    Dim Window As Object
    Dim my_title As String

    For Each Window In Windows
        my_title = Window.LocationName
        Debug.Print "Window Title = " & my_title
        If InStr(1, my_title, WindowName) Then
            Set IE = Window
            Exit For
        End If
    Next Window

    If Not IE Is Nothing Then 'Make sure IE was found as a window
        If CBool(IsIconic(IE.hWnd)) Then ' If it's minimized, show it
            ShowWindow IE.hWnd, SW_RESTORE
        End If

        SetForegroundWindow IE.hWnd 'Set the window as the foreground
    Else
        Debug.Print (WindowName & " could not be located")
    End If

End Sub
Public Sub OpenIEURL(URL As String, Optional SecondURL As String)
 Application.Wait (Now() + TimeValue("00:00:01"))
 Set IEObj = CreateObject("InternetExplorer.Application")
    
 IEObj.navigate URL
 Do Until IEObj.readyState = 4
  DoEvents
 Loop
 IEObj.TheaterMode = True
 IEObj.Visible = True
 
 If SecondURL <> "" Then
  IEObj.navigate SecondURL
 End If
 
 'Bring IEObj to Focus
 HWNDSrc = IEObj.hWnd
 SetForegroundWindow HWNDSrc
 IEObj.Visible = False
 IEObj.Visible = True
 Call Activate_A_Window(URL)
End Sub
Public Sub CloseIEObj()
 'Unload IE
 IEObj.TheaterMode = False
 Application.Wait (Now() + TimeValue("00:00:04"))
 IEObj.Quit
 Set IEObj = Nothing
 Application.Wait (Now() + TimeValue("00:00:01"))
End Sub

模块：

Option Explicit
Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Const BM_CLICK = &HF5
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

Private Sub File_Download_Click_Save()
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "File_Download_Click_Save"
    
    'Find the File Download window, waiting a maximum of 30 seconds for it to appear
    
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow("#32770", "File Download")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    
    Debug.Print "   File Download window "; Hex(hWnd)
    
    If hWnd Then
        'Find the child Save button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Click the Save button
        
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub

Public Sub WVinput()
 Dim URL As String
 URL = "http://url.com"
 Call OpenIEURL(URL)
 
    IEObj.document.getElementById("buttonExcel").Click ' Hit Excel Button
    Application.Wait (Now() + TimeValue("00:00:10"))

    Call File_Download_Click_Save ' This didn't work

'wait for save as window to appear
Dim o As IUIAutomation
Dim h As LongPtr
Set o = New CUIAutomation
h = 0
Do Until h > 0
    'h = ie.hWnd
    h = FindWindow("#32770", "Internet Explorer")
Loop

'find and click save as button
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim Button As IUIAutomationElement
Set e = o.ElementFromHandle(ByVal h)
Set Button = Nothing
Do Until Not Button Is Nothing
    'Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save as")
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save") ' Note I'm trying to hit "Save" not "Save As"
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Loop

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

    'SendKeys old method
    'SendKeys "%s", True ' Select "Save" in DL Window
    'Application.Wait (Now() + TimeValue("00:00:02"))
    'SendKeys "%s", True ' Select "Save" in DL Window
    Application.Wait (Now() + TimeValue("00:00:02"))
    
 Call CloseIEObj
 
End Sub

Answer 1

知道了！现在我的子程序中根本没有 SendKeys，但我确实必须短暂显示 IE 对象才能找到“保存按钮”。可靠性提高了 10 倍！

函数：

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function CloseClipboard Lib "user32" () As Long
      Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If

Public IEObj As Object, HWNDSrc As LongPtr

Public Sub Activate_A_Window(WindowName As String)
    Dim IE As Object
    Dim Windows As Object: Set Windows = CreateObject("Shell.Application").Windows
    Dim Window As Object
    Dim my_title As String

    For Each Window In Windows
        my_title = Window.LocationName
        Debug.Print "Window Title = " & my_title
        If InStr(1, my_title, WindowName) Then
            Set IE = Window
            Exit For
        End If
    Next Window

    If Not IE Is Nothing Then 'Make sure IE was found as a window
        If CBool(IsIconic(IE.hWnd)) Then ' If it's minimized, show it
            ShowWindow IE.hWnd, SW_RESTORE
        End If

        SetForegroundWindow IE.hWnd 'Set the window as the foreground
    Else
        Debug.Print (WindowName & " could not be located")
    End If

End Sub

Public Sub OpenIEURL(URL As String, Optional ShowIEWindow As Boolean, Optional SecondURL As String)
 Application.Wait (Now() + TimeValue("00:00:01"))
 Set IEObj = CreateObject("InternetExplorer.Application")
    
 IEObj.navigate URL
 Do Until IEObj.readyState = 4
  DoEvents
 Loop
 If ShowIEWindow = True Then
  IEObj.TheaterMode = True
  IEObj.Visible = True
 End If
 
 If SecondURL <> "" Then
  IEObj.navigate SecondURL
 End If
 
 'Bring IEObj to Focus
 HWNDSrc = IEObj.hWnd
 'Debug.Print HWNDSrc
 
 If ShowIEWindow = True Then
  SetForegroundWindow HWNDSrc
  IEObj.Visible = False
  IEObj.Visible = True
  Call Activate_A_Window(URL)
 End If
End Sub

Public Sub File_Download_Click_Save(HWNDSrc As LongPtr)
'find and click save as button
 Dim o As IUIAutomation
 Dim h As LongPtr
 Set o = New CUIAutomation
 h = HWNDSrc
 IEObj.Visible = True
 Dim e As IUIAutomationElement
 Dim iCnd As IUIAutomationCondition
 Dim Button As IUIAutomationElement
 Set e = o.ElementFromHandle(ByVal h)
 Set Button = Nothing
 Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
 Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
 Dim InvokePattern As IUIAutomationInvokePattern
 Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
 InvokePattern.Invoke
 IEObj.Visible = False
End Sub

Public Sub CloseIEObj()
 'Unload IE
 IEObj.TheaterMode = False
 Application.Wait (Now() + TimeValue("00:00:04"))
 IEObj.Quit
 Set IEObj = Nothing
 Application.Wait (Now() + TimeValue("00:00:01"))
End Sub

模块：

Public Sub WVinput()
 Dim URL As String
 URL = "http://url.com"
 Call OpenIEURL(URL)   

    IEObj.document.getElementById("buttonExcel").Click ' Hit Excel Button
    Application.Wait (Now() + TimeValue("00:00:10"))
    
    HWNDSrc = IEObj.hWnd
    Call File_Download_Click_Save(HWNDSrc)

    Application.Wait (Now() + TimeValue("00:00:02"))
    
 Call CloseIEObj
 
End Sub

注意：这需要 UIAutomationClient 参考库。

按保存按钮 IE 通过自定义功能下载提示

Press Save Button IE Download Prompt via Custom Functions

excel

internet-explorer

vba