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
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!
Reference: Put Blob (REST API) - Azure Storage | Microsoft Learn