在 VBA 中使用 WinINet API 将文件上传到 Azure Blob 时出现问题（错误 12031）

Question

我目前正在开发一个 VBA 解决方案，该解决方案使用 VBA 中的 WinINet API 将文件上传到 Azure Blob 存储。我遇到了几个问题，特别是 HttpSendRequestW 函数，该函数返回错误代码 12031 (ERROR_INTERNET_CONNECTION_RESET)。尽管添加了适当的标头并正确处理文件数据，请求还是失败。 代码概述：

Opening an Internet connection using InternetOpenW.
Connecting to Azure Blob Storage with InternetConnectW.
Opening a PUT request using HttpOpenRequestW.
Adding necessary headers (e.g., x-ms-blob-type: BlockBlob and Content-Length).
Sending the HTTP request with HttpSendRequestW, including file data from a local file.

问题：

在我发送请求之前，代码执行没有错误。但是，HttpSendRequestW 调用失败，错误代码为 12031，根据 Microsoft 文档，该错误代码指的是“连接重置”。我不确定为什么会发生这种情况，因为连接设置似乎很好。

采取的调试步骤：

我已确认标头已正确添加。 文件大小计算正确。 我使用 InternetSetOptionW 设置各种超时以避免过早超时问题。 文件缓冲区和其他参数似乎是有序的。

关键问题：

在 HttpSendRequestW 调用期间出现错误代码：12031（连接被对等方重置）。 超时：我使用 InternetSetOptionW 将连接、发送和接收超时设置为 60 秒，但问题仍然存在。

完整代码：

Public Sub UploadFileToAzureBlob2(ByVal filePath As String, ByVal Url As String, ByVal sasUrl As String)
    Dim hInternet As Long
    Dim hConnect As Long
    Dim hRequest As Long
    Dim Buffer() As Byte
    Dim FileHandle As Integer
    Dim dwFileSize As Long

    ' Open Internet connection
    hInternet = InternetOpenW(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
    If hInternet = 0 Then
        Debug.Print "Error opening Internet: " & ERR.LastDllError
        Exit Sub
    End If

    ' Extract the server name from the URL
    Dim serverName As String
    serverName = Mid(Url, InStr(Url, "//") + 2)
    Debug.Print "Server Name: " & serverName

    ' Connect to the Azure Blob Storage URL
    hConnect = InternetConnectW(hInternet, StrPtr(serverName), _
                                INTERNET_DEFAULT_HTTPS_PORT, 0, 0, INTERNET_SERVICE_HTTP, 0, 0)
    If hConnect = 0 Then
        Debug.Print "Error connecting to URL: " & ERR.LastDllError
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Extract the object name (container + blob name + SAS token)
    Dim objectName As String
    objectName = Mid(sasUrl, Len(Url) + 1)
    Debug.Print "Object Name: " & objectName

    ' Open an HTTP PUT request
    hRequest = HttpOpenRequestW(hConnect, StrPtr("PUT"), StrPtr(objectName), 0, 0, 0, INTERNET_FLAG_SECURE Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
    If hRequest = 0 Then
        Debug.Print "Error opening request: " & ERR.LastDllError
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Read file into buffer
    FileHandle = FreeFile
    Open filePath For Binary Access Read As FileHandle
    dwFileSize = LOF(FileHandle)
    If dwFileSize = 0 Then
        Debug.Print "Error: File size is zero"
        Close FileHandle
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If
    ReDim Buffer(dwFileSize - 1)
    Get FileHandle, , Buffer
    Close FileHandle

    ' Add headers
    If HttpAddRequestHeadersW(hRequest, StrPtr("x-ms-blob-type: BlockBlob" & vbCrLf), _
        ByVal Len("x-ms-blob-type: BlockBlob" & vbCrLf), 0) = 0 Then
        Debug.Print "Error adding blob type header: " & ERR.LastDllError
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Create the Content-Length header string
    Dim contentLength As String
    contentLength = "Content-Length: " & dwFileSize & vbCrLf

    ' Add the Content-Length header
    If HttpAddRequestHeadersW(hRequest, StrPtr(contentLength), _
        ByVal Len(contentLength) - 2, 0) = 0 Then ' Subtracting 2 for the CRLF
        Debug.Print "Error adding content length header: " & ERR.LastDllError
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Set timeouts
    Dim TIMEOUT_VALUE As Long
    TIMEOUT_VALUE = 60000 ' 60 seconds timeout
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_CONNECT_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_SEND_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)

    ' Send HTTP request with file data
    If HttpSendRequestW(hRequest, 0, 0, VarPtr(Buffer(0)), dwFileSize) = 0 Then
        Debug.Print "Error sending request: " & ERR.LastDllError
        Exit Sub
    Else
        Debug.Print "File uploaded successfully!"
    End If

    ' Close handles
    InternetCloseHandle hRequest
    InternetCloseHandle hConnect
    InternetCloseHandle hInternet
    Debug.Print "Upload completed successfully!"
End Sub

Answer 1

我目前正在开发一个 VBA 解决方案，该解决方案使用 VBA 中的 WinINet API 将文件上传到 Azure Blob 存储。

您可以使用以下 VBA 代码，使用

Azure Blob Storage

将文件从本地环境上传到

WinINet API

。

代码：

Private Declare PtrSafe Function InternetOpenA Lib "wininet.dll" ( _
    ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long

Private Declare PtrSafe Function InternetConnectA Lib "wininet.dll" ( _
    ByVal hInternet As Long, ByVal sServerName As String, _
    ByVal nServerPort As Integer, ByVal sUserName As String, _
    ByVal sPassword As String, ByVal lService As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare PtrSafe Function HttpOpenRequestA Lib "wininet.dll" ( _
    ByVal hConnect As Long, ByVal sVerb As String, _
    ByVal sObjectName As String, ByVal sVersion As String, _
    ByVal sReferrer As String, ByVal sAcceptTypes As String, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare PtrSafe Function HttpSendRequestA Lib "wininet.dll" ( _
    ByVal hRequest As Long, ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, ByVal sOptional As Any, _
    ByVal lOptionalLength As Long) As Long

Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInternet As Long) As Long

Const INTERNET_FLAG_SECURE = &H800000  

Sub UploadFileToAzureBlob()
    Dim hInternetSession As Long
    Dim hConnect As Long
    Dim hRequest As Long
    Dim fileBytes() As Byte
    Dim filePath As String
    Dim sasToken As String
    Dim blobName As String
    Dim serverName As String
    Dim requestPath As String
    Dim result As Long
    Dim header As String
    Dim lastError As Long

    ' Define the file path, Azure Blob Storage URL, SAS token, and blob name '
    filePath = "C:\Users\Downloads\test.png" 
    sasToken = "sv=2022-11-02&ss=bfqt&srt=sco&sp=rwdlacupiytfx&se=2024-10-07T15:35:17Z&st=2024-10-07T07:35:17Z&spr=https&sig=redacted" 
    blobName = "data.png" 
    serverName = "<storage account name>.blob.core.windows.net"
    requestPath = "/<container name>/" & blobName & "?" & sasToken
    
    fileBytes = ReadFileToBytes(filePath)
    
    hInternetSession = InternetOpenA("AzureUploadAgent", 1, vbNullString, vbNullString, 0)
    
    hConnect = InternetConnectA(hInternetSession, serverName, 443, vbNullString, vbNullString, 3, 0, 0)
    
    hRequest = HttpOpenRequestA(hConnect, "PUT", requestPath, "HTTP/1.1", vbNullString, vbNullString, INTERNET_FLAG_SECURE, 0)
    
    header = "Content-Type: application/octet-stream" & vbCrLf & "x-ms-blob-type: BlockBlob" & vbCrLf
    
    result = HttpSendRequestA(hRequest, header, Len(header), VarPtr(fileBytes(1)), UBound(fileBytes))
    
    If result = 0 Then
        lastError = Err.LastDllError
        MsgBox "Upload failed! Error: " & lastError
    Else
        MsgBox "Upload succeeded!"
    End If

    InternetCloseHandle hRequest
    InternetCloseHandle hConnect
    InternetCloseHandle hInternetSession
End Sub

Function ReadFileToBytes(filePath As String) As Byte()
    Dim fileNum As Integer
    Dim fileSize As Long
    Dim fileBytes() As Byte
    
    fileNum = FreeFile
    Open filePath For Binary As fileNum
    fileSize = LOF(fileNum)
    ReDim fileBytes(1 To fileSize)
    Get fileNum, 1, fileBytes
    Close fileNum
    
    ReadFileToBytes = fileBytes
End Function

输出：

Upload succeeded!

参考： Put Blob (REST API) - Azure 存储 |微软学习