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

Question

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

我发现了很多使用VBA控制的Internet Explorer的示例。然而，它大多是缓慢的解决方案，而且大多数也很复杂。

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

Answer 1

上述内容的修改版本，使其更具动态性。

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

Answer 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

源

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

这很有帮助，因为我们的组织有卡巴斯基AV，它阻止活动FTP。exe，但不是web连接。我们无法使用ftp内部开发。exe，这是我们的解决方案。希望这能帮助其他人查找信息！

Answer 3

此解决方案基于此网站：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