excel - 从 Excel 2019 中的 url 下载文件(适用于 Excel 2007)

Question

我得到了一个代码，可以从需要凭据的网站下载 CSV 文件。感谢这个网站，我得到了一个代码，我可以适应我的需要。我的相关代码部分是:

Option Explicit

Private Declare Function URLDownloadToFileA Lib "urlmon" _
    (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

Private Function DownloadUrlFile(URL As String, LocalFilename As String) As Boolean
    Dim RetVal As Long
    RetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
    If RetVal = 0 Then DownloadUrlFile = True
End Function

Sub DESCARGAR_CSV_DATOS()

Dim EstaURL As String
Dim EsteCSV As String

EstaURL = "https://user:token@www.privatewebsite.com/export/targetfile.csv"
EsteCSV = "MyCSV " & Format(Date, "dd-mm-yyyy") & ".csv"

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    DownloadUrlFile EstaURL, _
        ThisWorkbook.Path & "\" & EsteCSV

    DoEvents

    Workbooks.Open ThisWorkbook.Path & "\" & EsteCSV, , True, , , , , , , , , , , True

    'rest is just doing operations and calculations inside workbook

End Sub

抱歉，我无法提供真实的网址。无论如何，这段代码自 2019 年 9 月以来一直运行良好。而且它仍然每天都运行良好。

执行此代码的计算机都是 Windows 7 和 Excel 2007 和 64 位。他们都没有失败。

但现在，这项任务将外包给另一个办公室。在那里，计算机是 Excel 2019、Windows 10 和 64 位。

并且代码在那里不起作用。它不会出现任何错误，但函数 DownloadUrlFile不在 Excel 2019 + W10 上下载任何文件

因此，恢复，Excel 2007 + Windows 7 完美运行(今天测试)。 Excel 2019 + Windows 10 不起作用(屏幕上没有错误)。

我试图解决的问题:

1. I've checked that file urlmon.dll exists in system32 and it does
2. I've tried declaring the function URLDownloadToFileA using PtrSafe
3. If I manually type the url in Chrome in the PC with Excel 2019 + W10, the file is downloaded properly, so the URL is ok.

这些都没有解决我的问题。我很确定该解决方案非常简单，因为该代码在 Excel 2007 中完美运行，但我在这里找不到我所缺少的。

我想获得一个在任何情况下都有效的代码，但如果这是唯一的方法，我也会接受仅在 Excel 2019 和 Windows 10 中有效的解决方案。

希望有人可以对此有所了解。提前致谢。

更新 : 也尝试​​了 this post 中的解决方案但仍然没有。

更新 2:此外，使用 Excel 2010 测试了此处发布的代码(Excel 2007)，它运行良好。

更新 3:变量 RetVal存储下载的结果。我知道一些值(value)观:

' Returns 0 if success, error code if not.
' Error codes:
' -2146697210 "file not found".
' -2146697211 "domain not found".
' -2147467260 "transfer aborted".

但在我的情况下，它返回 -2147221020 .那会是什么？

更新 4:嗯，这很奇怪。我已尝试使用相同的代码从公共(public)网站下载不同的文件，它适用于 Excel 2019 + W10。
我制作了一个新的简单代码，如下所示:

#If VBA7 And Win64 Then
    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
#Else
    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 Descarga()
Dim EstaURL As String
Dim EsteCSV As String

EstaURL = privateone 'can't be shared, sorry
EsteCSV = "CSV Datos " & Format(Date, "dd-mm-yyyy") & ".csv"

    On Error GoTo Errores
    URLDownloadToFile 0, "https://tutorialesexcel.com/wp-content/uploads/2018/10/funciones.xlsm", ThisWorkbook.Path & "\" & EsteCSV, 0, 0
    URLDownloadToFile 0, EstaURL, ThisWorkbook.Path & "\" & EsteCSV, 0, 0
    Exit Sub
Errores:
    'Si es un bucle lo mejor sería no mostrar ningún mensaje
    MsgBox "Not downloaded", vbCritical, "Errores"
End Sub

显示 URLDownloadToFile 0, "https://tutorialesexcel.com/wp-content/uploads/2018/10/funciones.xlsm", ThisWorkbook.Path & "\" & EsteCSV, 0, 的行完美运行并下载文件。

行 URLDownloadToFile 0, EstaURL, ThisWorkbook.Path & "\" & EsteCSV, 0, 0不起作用。

所以再次测试完全相同的代码，但在 Excel 2007 和 上他们都工作

为什么第一次下载有效而第二次在 Excel 2019 + W10 上无效，但它们都在 Excel 2007+W7 上有效？

更新 5:该 URL 是私有(private)的，因为它包含用户名和密码，但它是这样的:
https://user:token@www.privatewebsite.com/export/target%20file.csv
感谢@Stachu，该 URL 不能在任何 PC 上的 Internet Explorer 上手动工作(我的意思是在资源管理器导航栏中复制/粘贴)。该 URL 在所有 PC 的 Google Chrome 中都能完美运行。

真的很好奇，手动地，Internet Explorer 上的 URL 不起作用，但是用 VBA 编码并在 Excel2007/2010 上执行的相同 URL 工作得很好。也许我应该改变一些关于编码的东西？

更新 6:还在研究你的所有帖子。这里的问题是我只是数据专家，分析师，所以这里发布的大量信息对我来说听起来真的很核心。

1 天前，我已将所有信息通过电子邮件发送给 IT 人员，但仍在等待答复。

同时，根据这里的信息，最终编写了适用于所有机器的完全不同的代码。它适用于 Windows 7 和 10，适用于 Excel 2007 和 2010(安装为 32 位)和 Excel 2019(安装为 64 位)。

我在这里添加代码，所以也许有人可以解释为什么它可以正常工作，但看起来问题是 base64 编码。

我现在得到的代码是这样的(添加了对Microsoft Winhttp Setvices 5.1的引用)

Application.ScreenUpdating = False

Dim whr As WinHttp.WinHttpRequest
Dim oStream As Object
Dim EsteCSV As String
Dim EstaURL As String


EstaURL = "https://user:pass@www.privatewebsite.com/export/target%20file.csv" 
EsteCSV = "CSV Datos" & Format(Date, "dd-mm-yyyy") & ".csv"

'Set whr = CreateObject("WinHttp.WinHttpRequest.5.1")

Set whr = New WinHttp.WinHttpRequest

whr.Open "GET", EstaURL, True
whr.setRequestHeader "Authorization", "Basic " & EncodeBase64("user" & ":" & "password")
whr.send

' Using 'true' above and the call below allows the script to remain responsive.
whr.waitForResponse
DoEvents

Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write whr.responseBody
oStream.SaveToFile ThisWorkbook.Path & "\" & EsteCSV
oStream.Close
DoEvents

Set oStream = Nothing
whr.abort
Set whr = Nothing
'rest of code for operations

Kill ThisWorkbook.Path & "\" & EsteCSV

Application.ScreenUpdating = True

End Sub

Private Function EncodeBase64(text As String) As String
  Dim arrData() As Byte
  arrData = StrConv(text, vbFromUnicode)

  Dim objXML As Object
  Dim objNode As Object

  Set objXML = CreateObject("MSXML2.DOMDocument")
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = arrData
  EncodeBase64 = objNode.text

  Set objNode = Nothing
  Set objXML = Nothing
End Function

Answer 1

子代码很好。检查vba中工具菜单中的引用并声明ptrsafe如下

Private Declare PtrSafe Function URLDownloadToFileA Lib "urlmon" _