VBA：在JavaScript链接后下载文件 [英] VBA: Downloading a file behind JavaScript link

问题描述

如何编写VBA代码以下载位于JavaScript链接后面的文件？有关如何使用VBA从特定链接下载文件的资源很多，但是，没有资源显示如何在JavaScript链接后面下载文件。

How do you write VBA code to download a file sitting behind a JavaScript link? There are many resources on how to download a file from a specific link using VBA, however, none show how to download a file behind a JavaScript link.

例如，如何您是否在以下网站上下载了导出到电子表格后面的文件：
https://www.vanguardinvestments.com.au/retail/ret/investments/product.html#/fundDetail/wholesale/portId=8101/ assetCode = equity /？prices

In example, how do you download the file behind "Export to Spreadsheet" on this website: https://www.vanguardinvestments.com.au/retail/ret/investments/product.html#/fundDetail/wholesale/portId=8101/assetCode=equity/?prices

我们是否仍声明并使用urlmon？

Do we still declare and use urlmon?

'Declaration of API function for Office 2010+
Private Declare PtrSafe Function URLDownloadTOFile Lib "urlmon" Alias         
"URLDownloadToFileA" ( _
    ByVal pCaller As LongPtr, _
    ByVal sZURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As LongPtr, _
    ByVal lpfnCB As LongPtr _
) As LongPtr

#Else
'Declaration of API function for pre Office 2010 versions
Private 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
#End If

Sub DownloadOneFile()
    Dim FileURL As String
    Dim DestinationFile As String

    'How do you modify this to handle a javascript link?
    FileURL = "https://www.vanguardinvestments.com.au/retail/ret/investments/product.html#/fundDetail/wholesale/portId=8101/assetCode=equity/?prices"
    DestinationFile = "C:\VBA\prices.csv"

    URLDownloadToFile 0, FileURL, DestinationFile, 0, 0

End Sub

推荐答案

这将触发该事件。归功于 @ Greedo 的原理是通过循环直到页面中可见指定的元素来等待页面加载。抱歉，该发送密钥令人恐惧。

This will fire the event. Credit to @Greedo for the principle of waiting for page to load by looping until a specified element is visible in the window. Sorry about the dreaded send keys.

Public Sub DownloadFile()

    Dim objIE As InternetExplorer, currPage As HTMLDocument, url As String
    url = "https://www.vanguardinvestments.com.au/retail/ret/investments/product.html#/fundDetail/wholesale/portId=8101/assetCode=equity/?prices"
    Set objIE = New InternetExplorer
    objIE.navigate url
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
    Set currPage = objIE.document
    objIE.Visible = True
    Dim myDiv As HTMLDivElement: Set myDiv = currPage.getElementById("price-distribution")
    Dim elemRect As IHTMLRect: Set elemRect = myDiv.getBoundingClientRect
    Do Until elemRect.bottom > 0
        currPage.parentWindow.scrollBy 0, 10000
        Set elemRect = myDiv.getBoundingClientRect
    Loop

    objIE.document.getElementsByClassName("export_icon hideOnSml ng-binding")(0).FireEvent "onclick"

    Application.SendKeys "%{S}"

End Sub

如果有必要，您可以在发送键之前添加以下内容，以确保窗口已打开，但目前看来仍然可以正常工作。

If necessary you might add something like the following before the send keys to ensure window is up but seems to work as is at present.

    Dim objShell As Shell
    Set objShell = New Shell

    Application.Wait Now + TimeSerial(0, 0, 10) 'alter to give enough time for window
    For Each objIE In objShell.Windows
        If TypeName(objIE.document) = "HTMLDocument" Then
            If InStr(objIE.document.title, "vanguard") > 0 Then
                objIE.Visible = True
                Exit For
            End If
        End If
    Next objIE

这篇关于VBA：在JavaScript链接后下载文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！