VBA:下载JavaScript链接后面的文件

时间:2018-04-15 06:08:26

标签: javascript vba file download

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

在示例中,如何下载本网站上“导出到电子表格”背后的文件: https://www.vanguardinvestments.com.au/retail/ret/investments/product.html#/fundDetail/wholesale/portId=8101/assetCode=equity/?prices

我们还要声明并使用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

1 个答案:

答案 0 :(得分:0)

这将触发事件。感谢@Greedo通过循环等待页面加载的原则,直到窗口中的指定元素可见。对于可怕的发送密钥感到抱歉。

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

如果有必要,您可以在发送密钥之前添加类似下面的内容,以确保窗口已启动但似乎现在正常工作。

    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