VBA用于单击链接以启动下载

Question

我是IE自动化的新手。虽然我能够根据td / tr抓取数据，但我无法点击链接下载文件。

如何点击链接使用VBA下载文件？

检查我需要点击“下载文件”的链接元素：

 <div id = "export">
<imgsrc = "image url">
<a onclick = "core.essres.exportres();" href = "JavaScript: void (0);">"download file" </a>

Answer 1

这样的事情

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

Declare PtrSafe Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
                (ByVal hWnd As LongPtr, ByVal wFlag As Long) As LongPtr

Declare PtrSafe Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As LongPtr) As Long

Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare PtrSafe Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)


Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Const BM_CLICK = &HF5
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

Public Const VK_KEYDOWN = &H0
Public Const VK_KEYUP = &H2
Public Const VK_CONTROL = &H11

Public Const GW_HWNDNEXT = 2



Sub Download()
    Dim IeApp As InternetExplorer
    Dim IeDoc As Object
    Dim ieTable As Object
    Dim objElement As IHTMLElement
    ' here if you have problems with IE you must kill all IE windows
    'downloadF = Environ("USERPROFILE") & "\Downloads\"  ' this is your download folder
    Set IeApp = New InternetExplorer
        IeApp.Visible = True
        IeApp.Navigate "http://www.yoursite.com"
            Do Until IeApp.Busy = False And IeApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop
        Set IeDoc = IeApp.Document
        IeDoc.GetElementById("export").click
        ' or IeDoc.GetElementById("export").FireEvent ("onclick") or else depending on page requerments
        Download_Default IeApp ' auto pressing Save button
        Application.Wait (Now + TimeValue("0:00:10")) ' wait for download
End Sub


Private Sub Download_Default(ByRef oBrowser As InternetExplorer)
 'AddReference
    Dim AutomationObj As IUIAutomation
    Dim WindowElement As IUIAutomationElement
    Dim Button As IUIAutomationElement
    Dim hWnd As LongPtr

    Set AutomationObj = New CUIAutomation

    Do While oBrowser.Busy: DoEvents: Loop  ' Or oBrowser.readyState <> 4
    Application.Wait (Now + TimeValue("0:00:05"))
    hWnd = oBrowser.hWnd
    hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
    If hWnd = 0 Then MsgBox " Not exist": Exit Sub

    Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
        Dim iCnd As IUIAutomationCondition
        Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Save")
            Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
                Dim InvokePattern As IUIAutomationInvokePattern
                Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke


End Sub

Answer 2

IE浏览器：

您可以使用ID进行单击

ie.document.querySelector("#export").click

或者attribute = value选择器

ie.document.querySelector("[onclick='core.essres.exportres();']").click

甚至可以直接尝试执行onclick功能

ie.document.parentWindow.execScript "core.essres.exportres();"

另一个答案向您展示了如何处理SaveAs对话框。

---

直接下载：

您还可以在单​​击下载时使用开发工具，以查看与下载相关联的网络选项卡中是否存在可直接传递给urlmon or binary download的URL

---

硒：

你可以切换到selenium v​​ba，并选择浏览器，如chrome，你没有保存/打开对话框，你可以在哪里specify a default download location，甚至只是下载到你当前的默认值

Option Explicit
'download selenium https://github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0
'Ensure latest applicable driver e.g. ChromeDriver.exe in Selenium folder
'VBE > Tools > References > Add reference to selenium type library
Public Sub DownloadFile()
    Dim d As WebDriver
    Set d = New ChromeDriver
    Const URL = "url"

    With d
        .Start "Chrome"
        .get URL
        .FindElementById("export").Click
        Application.Wait Now + TimeSerial(0, 1, 0) ' leave time to download before exiting or _
        loop download folder checking for when new file appears (or expected file by name/part of file name
        .Quit
    End With
End Sub