【发布时间】：2021-01-26 22:14:25
【问题描述】：
我得到了一个代码，可以从需要凭据的网站下载 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 不起作用（屏幕上没有错误）。
我试图解决的问题：
- 我检查了文件
urlmon.dll存在于system32中，确实存在- 我尝试使用
PtrSafe声明函数URLDownloadToFileA- 如果我用 Excel 2019 + W10 在 PC 的 Chrome 中手动输入 url，文件下载正确，所以 URL 没问题。
这些都没有解决我的问题。我很确定解决方案真的很简单，因为代码在 Excel 2007 中完美运行，但我在这里找不到我缺少的东西。
我想获得一个在任何情况下都可以使用的代码，但如果这是唯一的方法，我也会接受仅适用于 Excel 2019 和 Windows 10 的解决方案。
希望有人能对此有所了解。提前致谢。
更新：也尝试了this post 中的解决方案，但仍然没有。
更新 2：另外，使用 Excel 2010 测试了此处发布的代码 (Excel 2007)，它运行良好。
更新 3： 变量 RetVal 存储下载结果。我知道一些价值观：
' Returns 0 if success, error code if not.
' Error codes:
' -2146697210 "file not found".
' -2146697211 "domain not found".
' -2147467260 "transfer aborted".
但就我而言，它返回-2147221020。那会是什么？
更新 4： 嗯，这很奇怪。我已尝试使用相同的代码从公共网站下载不同的文件，它适用于 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 是私有的，因为它包含用户名和密码，但它是这样的：
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
【问题讨论】：
-
评论不用于扩展讨论；这个对话是moved to chat。