VBA,用于单击链接以开始下载

时间:2019-04-04 06:26:26

标签: excel vba web-scraping

我是IE自动化的新手。虽然我可以基于td / tr抓取数据,但是我无法单击链接来下载文件。

如何单击链接以使用VBA下载文件?

在需要单击“下载文件”的链接中检查元素:

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

2 个答案:

答案 0 :(得分:0)

类似的东西

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

答案 1 :(得分:0)

Internet Explorer:

您可以点击使用ID

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

或attribute =值选择器

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

或者甚至尝试直接执行onclick函数

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

另一个答案显示了如何处理“另存为”对话框。


直接下载:

点击下载时,您还可以使用开发工具,以查看与下载相关联的网络标签中是否有网址,您可以将其直接传递给urlmon or binary download


硒:

您可以切换到硒vba并选择浏览器(例如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