Question

我正在尝试让VBA自动从IE保存文件。由于这些论坛上的各种帖子，我可以登录，浏览页面并单击下载链接。保存提示出现在IE的底部，然后我被卡住了：

我一直在尝试使用https://www.mrexcel.com/forum/excel-questions/502298-need-help-regarding-ie-automation-using-vba-post3272730.html#post3272730中的代码示例，但是第二个FindWindow始终返回0：

hWnd = FindWindowEx(hWnd, 0, "DUIViewWndClassName", vbNullString)

我在Excel 14和IE11中使用VBA 7.0。

原始帖子的顶部有一些建议：

'注意-IE可能会阻止下载，并在以下位置显示其信息栏标签顶部，并阻止该程序自动下载文件。为防止这种情况，请将NRLDC添加到IE的“受信任” 网站（工具-Internet选项-'安全-受信任的网站-网站）

由于IT政策，我无法访问受信任的站点列表，但是出现下载提示，所以我认为这不是问题。

我获取的代码来自Doongie的reply，这表明它已针对Windows 7更新：

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", "") 'returns various numbers on different runs: 20001h 10440h
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout

    Debug.Print "   File Download window "; Hex(hWnd)

    If hWnd Then
        SetForegroundWindow hWnd

        'Find the child DUIViewWndClassName window
        hWnd = FindWindowEx(hWnd, 0, "DUIViewWndClassName", vbNullString)    'always returns 0
        Debug.Print "   DUIViewWndClassName "; Hex(hWnd)
    End If

    If hWnd Then
        'Find the child DirectUIHWND window
        hWnd = FindWindowEx(hWnd, 0, "DirectUIHWND", "")
        Debug.Print "   DirectUIHWND "; Hex(hWnd)
    End If

    If hWnd Then
        'Find the child FloatNotifySink window
        hWnd = FindWindowEx(hWnd, 0, "FloatNotifySink", "")
        Debug.Print "   FloatNotifySink "; Hex(hWnd)
    End If

    If hWnd Then
        'Find the child ComboBox window
        hWnd = FindWindowEx(hWnd, 0, "ComboBox", "")
        Debug.Print "   ComboBox "; Hex(hWnd)
    End If

    If hWnd Then
        SetForegroundWindow hWnd

        'Find the child Edit window
        hWnd = FindWindowEx(hWnd, 0, "Edit", "")
        Debug.Print "   Edit "; Hex(hWnd)
    End If

    If hWnd Then        
        'Click the Save button
        SetForegroundWindow hWnd
        Sleep 600  'this sleep is required and 600 milliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If

End Sub

有什么方法可以检查IE元素的句柄号（不会给我带来麻烦！）？代码检查器仅显示页面代码，不显示IE对话框。

在某处定义了lpsz1的可能元素名称的列表，因为它们适用于IE的元素？

Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Answer 1

在我的IE Automation中，使用以下代码从IE保存文件。以下代码要求VBA引用UIAutomationCore.dll，可以在以下位置找到

％windir％/ sysWow64 / UIAutomationCore.dll

并启用对vba的信任访问

文件->选项->信任中心->信任中心设置->宏设置->检查信任对VBA的访问权限

Private Sub InvokeSaveButton(IEHwnd As Long)
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Set o = New CUIAutomation
Dim h As Long
h = IEHwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub

Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")

Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
End Sub

Answer 2

您尝试过可怕的sendkey吗？

Application.SendKeys "%{S}"
Application.SendKeys "%{O}"

Answer 3

您可以尝试urlmon库。将url和文件名+扩展名更改为所需的内容。

在您必须登录以获得该文件的网站上，它可能无法正常工作。

Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
    ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    Dim errValue As Long
    errValue = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If errValue = 0 Then
        MsgBox "Download Completed, saved at: " & LocalFilename
    Else
        MsgBox "There was an error downloading the file"
    End If
End Function
Sub DoIt()
    DownloadFile "http://www.blahblahblah.com/somefolder/somefiles.xlsx", "C:\Users\Public\Documents\SavedFile.xlsx"
End Sub

VBA单击Win7x64中的IE11另存为对话框

3 个答案: