URLからzipファイルをダウンロードするにはVBAを使用してください

Question

私はを参考にしてURLからzipファイルをダウンロードしています。

私が使用していたコードは、しかし、私は、コードを実行するたびに、それだけでそのファイルをダウンロードする空のzipファイルを作成しますで

Sub DownloadZipExtractCsvAndLoad() 
    Dim UrlFile As String, ZipFile As String, CsvFile As String, Folder As String, s As String 
    ' UrlFile to the ZIP archive 
    UrlFile = "https://loanperformancedata.fanniemae.com/lppub/publish?file=2008Q1.zip" 
    ' Extract ZipFile from UrlFile 
    ZipFile = "2008Q1.zip" 
    ' Define temporary folder 
    Folder = "C:\Users\xxxxxx\Desktop\" 
    ' Disable screen updating to avoid blinking 
    Application.ScreenUpdating = False 
    ' Trap errors 
    On Error GoTo exit_ 
    ' Download UrlFile to ZipFile in Folder 
    If Not Url2File(UrlFile, Folder & ZipFile, "xxx", "xxxx") Then 
    MsgBox "Can't download file" & vbLf & UrlFile, vbCritical, "Error" 
    Exit Sub 
    End If 
exit_: 
    ' Restore screen updating 
    Application.ScreenUpdating = True 
    ' Inform about the reason of the trapped error 
    If Err Then MsgBox Err.Description, vbCritical, "Error" 
End Sub 

Function Url2File(UrlFile As String, PathName As String, Optional Login As String, Optional Password As String) As Boolean 
'ZVI:2017-01-07 Download UrlFile and save it to PathName. 
'    Use optional Login and Password if required. 
'    Returns True on success downloading. 
    Dim b() As Byte, FN As Integer 
    On Error GoTo exit_ 
    If Len(Dir(PathName)) Then Kill PathName 
    With CreateObject("MSXML2.XMLHTTP") 
    .Open "GET", UrlFile, False, Login, Password 
    .send 
    If .Status <> 200 Then Exit Function 
    b() = .responseBody 
    FN = FreeFile 
    Open PathName For Binary Access Write As #FN 
    Put #FN, , b() 
exit_: 
    If FN Then Close #FN 
    Url2File = .Status = 200 
    End With 
End Function 

下回っています。

助けが必要ですか？

b = fileObj.responseBody 
. 
. 
Put #FN, , b 

：

Answer 1

私はあなたがそれがあるべき下

周辺のB（）である

にWebブラウザとログを使用してファイルを取得することができていることを前提とし私はそれを検索してそれをテストしましたUrlFile = "https://www.google.ca/"

ステータスを印刷するために2行追加しましたファイル取得の試行後に

Sub DownloadZipExtractCsvAndLoad() 

    Dim UrlFile As String, ZipFile As String, CsvFile As String, Folder As String, s As String 


    UrlFile = "https://loanperformancedata.fanniemae.com/lppub/publish?file=2008Q1.zip" ' UrlFile to the ZIP archive 
    ZipFile = "2008Q1.zip"                 ' Extract ZipFile from UrlFile 

    UrlFile = "https://www.google.ca/"     ' debug ... test url 
    ZipFile = "2008Q1.html"        ' debug ... test file 

    Folder = "C:\Users\js135001\Desktop\"             ' Define temporary folder 
    Application.ScreenUpdating = False              ' Disable screen updating to avoid blinking 

' On Error GoTo exit_err                ' Trap errors 

    If Not Url2File(UrlFile, Folder & ZipFile, "xxx", "xxxx") Then       ' Download UrlFile to ZipFile in Folder 
     MsgBox "Can't download file" & vbLf & UrlFile, vbCritical, "Error" 
     Exit Sub 
    End If 

exit_err: 
    Application.ScreenUpdating = True              ' Restore screen updating 

    If Err Then MsgBox Err.Description, vbCritical, "Error"        ' Inform about the reason of the trapped error 

End Sub 

Function Url2File(UrlFile As String, PathName As String, Optional Login As String, Optional Password As String) As Boolean 
    ' ZVI:2017-01-07 Download UrlFile and save it to PathName. 
    '    Use optional Login and Password if required. 
    '    Returns True on success downloading. 

    Dim b() As Byte, FN As Integer 

' On Error GoTo exit_err 

    If Len(Dir(PathName)) Then Kill PathName 

    Dim httpObj As Object 
    Set httpObj = CreateObject("MSXML2.XMLHTTP") 

    httpObj.Open "GET", UrlFile, False, Login, Password 
    httpObj.send 

    Debug.Print httpObj.Status    ' debug 
    Debug.Print httpObj.statusText   ' debug 

    If httpObj.Status <> 200 Then Exit Function 

    b = httpObj.responseBody 
    FN = FreeFile 
    Open PathName For Binary Access Write As #FN 
    Put #FN, , b 

' Put #FN, , httpObj.responseBody ' you could do this, and not use b() at all 

exit_err: 
    If FN Then Close #FN 
    Url2File = (httpObj.Status = 200)    ' return true/false 

End Function