vbams-accessazure-blob-storagehttprequestwininet

Issues with Uploading Files to Azure Blob Using WinINet API in VBA (Error 12031)


I'm currently working on a VBA solution that uploads files to Azure Blob Storage using the WinINet API in VBA. I've encountered several issues, specifically with the HttpSendRequestW function, which returns error code 12031 (ERROR_INTERNET_CONNECTION_RESET). Despite adding appropriate headers and handling file data correctly, the request fails. Code Overview:

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.

Problem:

The code executes without errors up to the point where I send the request. However, the HttpSendRequestW call fails with error code 12031, which, according to Microsoft documentation, refers to "connection reset." I'm not sure why this happens, as the connection setup seems fine.

Debugging Steps Taken:

I've confirmed the headers are added correctly. The file size is calculated correctly. I set various timeouts using InternetSetOptionW to avoid premature timeout issues. The file buffer and other parameters appear to be in order.

Key Issue:

Error code: 12031 (Connection reset by peer) occurs during the HttpSendRequestW call. Timeouts: I set connection, send, and receive timeouts to 60 seconds using InternetSetOptionW, but the issue persists.

Full Code:

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

Solution

  • I'm currently working on a VBA solution that uploads files to Azure Blob Storage using the WinINet API in VBA.

    You can use the below VBA code that uploads files from local environment to Azure Blob Storage using WinINet API.

    Code:

    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
    

    Output:

    Upload succeeded!
    

    enter image description here

    Reference: Put Blob (REST API) - Azure Storage | Microsoft Learn