使用VBA通过Web API下载Zip文件出现损坏问题

Hey there, let's get to the bottom of why your downloaded zip files are corrupted and smaller than expected. I've dealt with this exact issue dozens of times, so here's what's going wrong and how to fix it.

Common Causes of the Problem #

The URLDownloadToFile function is handy, but it has some critical limitations that often lead to incomplete or corrupted downloads:

• Missing Request Headers: Many servers block requests that don't include a proper User-Agent header (mimicking a browser). Without this, you might get a truncated response or an error page saved as a zip.
• HTTPS Certificate Issues: If the target URL uses HTTPS, URLDownloadToFile might fail to validate the certificate properly, resulting in a partial download.
• Redirect Handling: While it usually follows redirects, some complex redirect chains (like 302s with additional checks) can trip it up, leading to incomplete data.
• ANSI Encoding: You're using the URLDownloadToFileA (ANSI) alias—if your URL contains non-ASCII characters, this can cause encoding errors that break the download.

The Most Reliable Fix: Use MSXML2.XMLHTTP #

Instead of relying on URLDownloadToFile, switch to the MSXML2.XMLHTTP object. It gives you full control over the request, lets you validate responses, and handles binary data correctly. Here's a complete, tested script:

Sub DownloadValidZipFile()
    Dim http As Object
    Dim targetUrl As String
    Dim saveFilePath As String
    Dim fileData() As Byte
    Dim folderPath As String
    Dim fileNum As Integer
    
    ' Replace these with your actual URL and save path
    targetUrl = "https://example.com/your-file.zip"
    saveFilePath = "C:\Your\Target\Folder\downloaded-file.zip"
    
    ' Create the XMLHTTP object (use version 6.0 for best compatibility)
    Set http = CreateObject("MSXML2.XMLHTTP.6.0")
    
    ' Open the request and add a browser-like User-Agent header
    http.Open "GET", targetUrl, False
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36"
    
    ' Send the request
    http.send
    
    ' Check if the request succeeded (status code 200 = OK)
    If http.Status = 200 Then
        ' Extract binary data from the response
        fileData = http.responseBody
        
        ' Create the target folder if it doesn't exist
        folderPath = Left(saveFilePath, InStrRev(saveFilePath, "\"))
        If Dir(folderPath, vbDirectory) = "" Then
            MkDir folderPath
        End If
        
        ' Write the binary data to the zip file
        fileNum = FreeFile
        Open saveFilePath For Binary Access Write As #fileNum
            Put #fileNum, , fileData
        Close #fileNum
        
        MsgBox "Zip downloaded successfully! File size: " & FileLen(saveFilePath) & " bytes", vbInformation
    Else
        MsgBox "Download failed. Status: " & http.Status & " - " & http.statusText, vbExclamation
    End If
    
    ' Clean up
    Set http = Nothing
End Sub

Why This Works Better: #

• Request Control: You can add headers like User-Agent to avoid being blocked by servers.
• Response Validation: Checking the Status property ensures you only save valid content (not error pages).
• Binary Handling: Directly writing responseBody (raw binary data) eliminates encoding issues that corrupt zips.

If You Must Use URLDownloadToFile #

If you need to stick with URLDownloadToFile, try these tweaks to mitigate the issues:

1. Use the Unicode Version: Replace URLDownloadToFileA with URLDownloadToFileW to handle non-ASCII URLs correctly.

2. Disable Certificate Validation (for testing only—this reduces security):

   Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" ( _
       ByVal hInternet As Long, _
       ByVal dwOption As Long, _
       ByRef lpBuffer As Any, _
       ByVal dwBufferLength As Long) As Long
   
   Const INTERNET_OPTION_SECURITY_FLAGS As Long = 31
   Const SECURITY_FLAG_IGNORE_UNKNOWN_CA As Long = &H100
   Const SECURITY_FLAG_IGNORE_CERT_DATE_INVALID As Long = &H200
   Const SECURITY_FLAG_IGNORE_CERT_CN_INVALID As Long = &H400
   
   Sub BypassCertCheck()
       Dim flags As Long
       flags = SECURITY_FLAG_IGNORE_UNKNOWN_CA Or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID Or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
       InternetSetOption 0, INTERNET_OPTION_SECURITY_FLAGS, flags, Len(flags)
   End Sub
   

   Call BypassCertCheck() before invoking URLDownloadToFile.

3. Verify the URL: Test the URL directly in your browser to confirm it downloads a valid zip—this rules out issues with the server itself.

内容的提问来源于stack exchange，提问作者mean_