【发布时间】：2021-02-18 21:12:10
【问题描述】：
我已经设法从我的 sub 中删除所有 sendkey 以从 IE 中提取电子表格，除了在最后点击下载提示上的“保存”按钮。我知道有很多关于此的帖子，并且我都阅读了它们，但是今天我发现了一个看起来很棒的功能，但我似乎无法适应它/让它发挥作用。
注意：这不是我可以使用 Params 调用的 URL，但我在页面上输入信息并点击按钮 Excel，然后返回电子表格的下载提示。
我也不确定下面的代码是要在“下载”完整窗口（CTRL + J）还是底部的提示栏上运行，但我都试过了，但都没有运气。如果需要，我可以打开“完整窗口”，但它需要我希望消除的 sendkeys，但目前代码自然只是在窗口底部显示下载“栏”。
这里有一些链接：
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
到目前为止，这是我的代码，每个链接都有两个变体：
函数（独立模块）
#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
【问题讨论】：
标签： excel vba internet-explorer