时间戳

首页 > 解决方案 > 使用 web api 下载 zip 文件会导致文件损坏

excel - 使用 web api 下载 zip 文件会导致文件损坏

问题描述

我有一个 VBA 代码，它根据 URL 下载一个 zip 文件并将其保存到一个文件夹中。但是，下载的文件已损坏。使用 VBA 代码下载的文件的文件大小明显小于实际文件。下面是我正在使用的代码：

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

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Sub DownloadFile 
    Dim L as long
    L = URLDownloadToFile(0&, UrlFileName, DestinationFileName, 0&, 0&)

    If L = 0 Then
      Debug.Print "Download successful"
    Else
       Debug.Print "Download unsuccessful"
    End If
End Sub

` 我正在下载 ZIP 文件的站点需要登录，并且我在运行上述 VBA 代码之前登录到该站点。

示例 URL（不是真实 URL）：https ://www.samplewebsite.org/bsplink14/updownload/motorqcopia2.asp?vr=&name=VBGHFaz7243%5F20180424%5F0403%5FAirline%5FZCVDRFDBilling.zip&filtroread=true&extid=INDEFD1834262&rif=3373&s3s=497c7d4bc297bdccac4c4c

你能帮我解决这个问题吗？

标签： excelvba

解决方案

确保引用 MSXML，插入一个类模块，并在其中插入以下代码。仅在该函数返回 True 的情况下才执行 DownloadToFile，应该可以工作。

Public Function DoLoginByPost(URL As String, strUser As String, strPassword As String) As Boolean

    Dim xHttp As MSXML2.XMLHTTP
    Dim sTICKER As String

    sTICKER = "user=" & strUser & "&pass=" & strPassword & "&logintype=login&pid=4&login=Login" 
    'Check this and edit accordingly by e.g. using the web developer tools in your browser when logging in regularly.
    'You should be able to identify what form data is being sent when loggin on.
    Set xHttp = New MSXML2.XMLHTTP
    xHttp.Open "POST", URL
    xHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xHttp.send sTICKER

    Do Until xHttp.READYSTATE = 4
        DoEvents
    Loop

    If xHttp.Status = 200 Then
        DoLoginByPost = True
        Else:   DoLoginByPost = False
    End If

End Function



'After receiving "TRUE", alter your original code to:

Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "Get", UrlFileName, False
xHttp.send

Do Until xHttp.ReadyState = 4
  DoEvents
Loop

Open DestinationFileName For Binary As #1
   Put #1, , xHttp.responseBody
Close #1

推荐阅读