下载文件;使用.execScript VBA执行JavaScript函数

下载文件;使用.execScript VBA执行JavaScript函数,javascript,html,vba,excel,web-scraping,Javascript,Html,Vba,Excel,Web Scraping,情况: 我正在从网页下载文件 在HTML中,我可以看到以下内容: onclick="ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');" 在查看并看到这些SO问题(以及其他问题)后: 我的印象是,ga()是一个JavaScript函数,我

情况:

我正在从网页下载文件

在HTML中,我可以看到以下内容:

onclick="ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');"
在查看并看到这些SO问题(以及其他问题)后:

我的印象是,
ga()
是一个JavaScript函数,我应该能够使用
.execScript
直接调用它

问题:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub
我可以使用
.execScript
下载文件来执行JavaScript函数吗?如果没有,我如何下载文件

我尝试过的:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub
我尝试了以下方法,但没有成功:

1)
调用html.parentWindow.execScript(“ga('send'、'event'、'Downloads'、'XLS'、'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)

'-2147352319自动化错误


2)
调用html.frames(0).execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)

错误438对象不支持此属性或方法


3)
调用currentWindow.execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)

错误91对象变量或未设置块变量


4)
调用CurrentWindow.execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)

-由于错误80020101,2147352319无法完成操作

我承认我对这类行动知之甚少。谁能看出我哪里做错了吗

代码:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub
选项显式
公共子下载DTOC()
Dim http作为新的XMLHTTP60
Dim html作为新的HTMLDocument
将CurrentWindow设置为HTMLWindowProxy
使用http
.打开“获取”https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/”“错
.发送
html.body.innerHTML=.responseText
以
在错误上走错
调用html.parentWindow.execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)-2147352319自动化错误
'调用html.frames(0.execScript)('ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)“438对象不支持此属性或方法
“自动化错误
调用currentWindow.execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)“91对象变量或未设置块变量
设置CurrentWindow=html.parentWindow
调用CurrentWindow.execScript(“ga('send','event','Downloads','XLS','https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls“);”,“Javascript”)--2147352319由于错误80020101而无法完成操作。
出口接头
错误:
如果错误号为0,则调试.打印错误号,错误说明
端接头
新增参考文献:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub

这里是HTML的简化版本。抱歉,我不习惯格式化HTML




因此,我最终使用CSS选择器获取下载的所有HREF,并将它们传递给URLMon进行下载。因为最新的文件有两个月的延迟,所以我在这两个月后过滤了要下载的文件


CSS选择器:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub
我选择的选择器是
#主内容a[href*=xls]

这将查找带有
a
标记的元素的元素,这些元素的属性
href
包含字符串
“xls”
,元素的id为
main=content


CSS查询结果示例:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub


VBA:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub

参考文献:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub
需要HTML对象库和Microsoft XML的引用


API调用:

Option Explicit

Public Sub DownloadDTOC()

    Dim http As New XMLHTTP60
    Dim html As New HTMLDocument
    Dim CurrentWindow As HTMLWindowProxy

    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/delayed-transfers-of-care-data-2017-18/", False
        .send
        html.body.innerHTML = .responseText
    End With

    On Error GoTo Errhand

    'Call html.parentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '-2147352319   Automation error

    'Call html.frames(0).execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '438 Object doesn't support this property or method
'automation error

    'Call currentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") ' 91 Object variable or With block variable not set

    Set CurrentWindow = html.parentWindow
    Call CurrentWindow.execScript("ga('send', 'event', 'Downloads', 'XLS', 'https://www.england.nhs.uk/statistics/wp-content/uploads/sites/2/2018/01/LA-Type-B-November-2017-2ayZP.xls');", "Javascript") '--2147352319  Could not complete the operation due to error 80020101.

    Exit Sub

Errhand:
    If Err.Number <> 0 Then Debug.Print Err.Number, Err.Description
End Sub
Option Explicit
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 Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String _
) As Long

Public Const BINDF_GETNEWESTVERSION As Long = &H10

Public Sub DownloadFiles()
    Dim http As New XMLHTTP60, html As New HTMLDocument, downloads As Collection
    With http
        .Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/delayed-transfers-of-care/statistical-work-areas-delayed-transfers-of-care-delayed-transfers-of-care-data-2018-19/", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim aNodeList As Object, i As Long
    Set downloads = New Collection
    Set aNodeList = html.querySelectorAll("#main-content a[href*=xls]")
    For i = 0 To aNodeList.Length - 1
        downloads.Add aNodeList.item(i).getAttribute("href")
    Next i

    For i = 1 To downloads.Count
        If InStr(downloads(i), Format(DateAdd("m", -2, Date), "mmmm-yyyy")) > 0 Then
            Debug.Print downloads(i)
            downloadFile downloads(i)
        End If
    Next i
End Sub

Public Sub downloadFile(ByVal url As String)
    Dim ret As Long, arr() As String, outputPath As String
    arr = Split(url, Chr$(47))
    outputPath = "C:\Users\HarrisQ\Desktop\" & arr(UBound(arr))
    ret = URLDownloadToFile(0, url, outputPath, BINDF_GETNEWESTVERSION, 0)
End Sub

为64位编写的

我知道IE能很好地处理
.execScript
。您是否尝试过通过隐藏的IE窗口打开它,然后执行脚本?是否尝试过在class
xls link
中获取文本
onclick
在该类中也可用。但是,我想说的是,
xmlhttp60
request将无法从该页面获取任何内容,因为它甚至无法解析该类中的文本。该网站的内容是动态生成的。你应该选择IE。我会尝试使用IE。我故意避免使用IE,因为它很慢。@Shahin作为旁白,当我尝试使用“xls链接”按类名获取时,没有返回任何内容。这与.OuterHTML与.Inner有关吗?ga()只是对google analytics的一个调用,它不会影响下载,您真的需要调用它吗?