如何使用 VBA（没有 Internet Explorer）下载文件

Posted 2023-03-15

【中文标题】如何使用 VBA（没有 Internet Explorer）下载文件

【英文标题】：How do I download a file using VBA (without Internet Explorer)

【发布时间】：2013-07-26 11:44:52

【问题描述】：

我需要在 Excel 中使用 VBA 从网站下载 CSV 文件。服务器还需要对我进行身份验证，因为它是来自调查服务的数据。

为此，我找到了很多使用 VBA 控制的 Internet Explorer 的示例。然而，它大多是缓慢的解决方案，而且大多数也是令人费解的。

更新： 过了一会儿，我发现了一个在 Excel 中使用 Microsoft.XMLHTTP 对象的绝妙解决方案。我想分享下面的解决方案以供将来参考。

【参考方案1】：

此解决方案基于此网站： http://social.msdn.microsoft.com/Forums/en-US/bd0ee306-7bb5-4ce4-8341-edd9475f84ad/excel-2007-use-vba-to-download-save-csv-from-url

稍作修改以覆盖现有文件并传递登录凭据。

Sub DownloadFile()

Dim myURL As String
myURL = "https://YourWebSite.com/?your_query_parameters"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "C:\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Sub

【讨论】：

谢谢——非常酷。我唯一的问题是，任何访问您文件的 VBA 的人都有您的密码。有什么技巧可以解决这个问题或以某种方式对其进行加密吗？再次感谢！

没问题 :) 你是对的，在你的代码中存储密码不是一个好习惯。在 Ruby 中我总是使用环境变量，您可能可以在 VBA 中做类似的事情。在 excel 中，您可以加密文件，以便用户无法查看您的代码。我从来没有试过这个，但试试这个链接：vbaexpress.com/forum/…

“myURL = ...responseBody”（就在 If 之前）有什么用？似乎没有必要……

可以直接在excel中使用workbook.open打开oStream吗？？

谢谢。我想补充一点，如果您指定了Option Explicit，您还需要声明 oStream：Dim oStream As Object

【参考方案2】：

Declare PtrSafe 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

Sub Example()
    DownloadFile$ = "someFile.ext" 'here the name with extension
    URL$ = "http://some.web.address/" & DownloadFile 'Here is the web address
    LocalFilename$ = "C:\Some\Path" & DownloadFile !OR! CurrentProject.Path & "\" & DownloadFile 'here the drive and download directory
    MsgBox "Download Status : " & URLDownloadToFile(0, URL, LocalFilename, 0, 0) = 0
End Sub

Source

我在使用 URL 中的用户名和地址寻找从 FTP 下载时发现了上述内容。用户提供信息，然后拨打电话。

这很有帮助，因为我们的组织有 Kaspersky AV，它阻止 active FTP.exe，但不阻止 Web 连接。我们无法使用 ftp.exe 进行内部开发，这是我们的解决方案。希望这有助于其他寻找信息的人！

【讨论】：

这很有帮助，但是，我必须添加对 Microsoft WinHTTP 服务的引用才能使其正常工作。 （在 VBA 编辑器中：Tools/References/Microsoft WinHTTP Services，5.1 版）。不知道这对其他人是否显而易见。

@DRC 我知道你的评论在这一点上已经有一年了，但我在将近 3 年前写了这篇文章。我们当时在我们的脚本中导入了一些其他的东西，但我很高兴你能得到一些帮助！

【参考方案3】：

上面的修改版本，使其更具动态性。

Public Function DownloadFileB(ByVal URL As String, ByVal DownloadPath As String, ByRef Username As String, ByRef Password, Optional Overwrite As Boolean = True) As Boolean
    On Error GoTo Failed

    Dim WinHttpReq          As Object: Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")

    WinHttpReq.Open "GET", URL, False, Username, Password
    WinHttpReq.send

    If WinHttpReq.Status = 200 Then
        Dim oStream         As Object: Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile DownloadPath, Abs(CInt(Overwrite)) + 1
        oStream.Close
        DownloadFileB = Len(Dir(DownloadPath)) > 0
        Exit Function
    End If

Failed:
    DownloadFileB = False
End Function

【讨论】：

在回答一个老问题时，如果您包含一些上下文来解释您的答案如何提供帮助，那么您的答案将对其他 *** 用户更有用，特别是对于已经有一个已接受答案的问题。请参阅：How do I write a good answer。

【参考方案4】：

上述解决方案的修改版本，使其更具动态性。

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

Public Function DownloadFileA(ByVal URL As String, ByVal DownloadPath As String) As Boolean
    On Error GoTo Failed
    DownloadFileA = False
    'As directory must exist, this is a check
    If CreateObject("Scripting.FileSystemObject").FolderExists(CreateObject("Scripting.FileSystemObject").GetParentFolderName(DownloadPath)) = False Then Exit Function
    Dim returnValue As Long
    returnValue = URLDownloadToFile(0, URL, DownloadPath, 0, 0)
    'If return value is 0 and the file exist, then it is considered as downloaded correctly
    DownloadFileA = (returnValue = 0) And (Len(Dir(DownloadPath)) > 0)
    Exit Function

Failed:
End Function

【讨论】：

这是如何使用的？我像调用 DownloadFileA("mylink.csv", ProjectNetworkLoadPath) 一样运行它，没有错误，也没有下载文件

【参考方案5】：

我为此苦苦挣扎了几个小时，直到我发现它可以在一行 powershell 中完成：

invoke-webrequest -Uri "http://myserver/Reports/Pages/ReportViewer.aspx?%2fClients%2ftest&rs:Format=PDF&rs:ClearSession=true&CaseCode=12345678" -OutFile "C:\Temp\test.pdf" -UseDefaultCredentials

我曾考虑纯粹在 VBA 中执行此操作，但它会运行到多个页面，因此每次我想下载文件时，我只需从 VBA 调用我的 powershell 脚本。

简单。

【参考方案6】：

Public Sub Test_DownloadFile()
 Dim URLStr As String, DLPath As String, UName As String, PWD As String, DontOverWrite As Boolean
 URLStr = "http.."
 DLPath = Environ("USERPROFILE") & "\Downloads\TEST.PDF"
 UName = ""
 PWD = ""
 DontOverWrite = False
 Call DownloadFile(URLStr, DLPath, UName, PWD, DontOverWrite)
End Sub

---

Public Sub DownloadFile(ByVal URLStr As String, ByVal DLPath As String, Optional ByVal UName As String, Optional ByVal PWD As String, Optional DontOverWrite As Boolean)
 On Error GoTo Failed

 Dim WinHttpReq As Object
 Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
 WinHttpReq.Open "GET", URLStr, False, UName, PWD
 WinHttpReq.send

If WinHttpReq.status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    Dim OWrite As Integer
    If DontOverWrite = True Then
     OWrite = 1
    Else
     OWrite = 2
    End If
    oStream.SaveToFile DLPath, OWrite
    oStream.Close
    Debug.Print "Downloaded " & URLStr & " To " & DLPath
    Exit Sub
End If
Failed:
 Debug.Print "Failed to DL " & URLStr
End Sub