I’m trying to upload a file to Storage using Microsoft.XMLHTTP in VBA for MS Access with progress tracking. Uploading without progress tracking works fine, but I need to have progress tracking, especially for larger files.
I have a problem with this line:
xmlHttp.send fileData
err: The parameter is incorrect… I tried to divide the file into 5 portions and upload them, but I am doing something wrong. Here is the snippet:
Public Sub UploadToAzureBlob(filePath As String, fileName As String)
Dim adoStream As Object
Dim xmlHttp As Object
Dim responseStatus As Long
Dim sUrl As String
Dim fileSize As Long
Dim bytesSent As Long
Dim chunkSize As Long
Dim fileData() As Byte
Dim progressForm As Form
Dim numParts As Long
'On Error GoTo ErrHandler
filePath = filePath & fileName
fileName = "/" & URLEncodeJScript(fileName) ' For Azure in this format
sUrl = blobUrl & fileName & sasToken
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Mode = 3
adoStream.Type = 1
adoStream.Open
adoStream.LoadFromFile filePath
fileSize = adoStream.Size
numParts = 5
chunkSize = fileSize \ numParts
If chunkSize = 0 Then chunkSize = fileSize
DoCmd.OpenForm "dlgPRGBAR"
Set progressForm = Forms!dlgPRGBAR
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
bytesSent = 0
Do While bytesSent < fileSize
If bytesSent + chunkSize > fileSize Then
chunkSize = fileSize - bytesSent
End If
adoStream.Position = bytesSent
ReDim fileData(0 To chunkSize - 1)
fileData = adoStream.Read(chunkSize)
Debug.Print "Chunk size: " & chunkSize & " Bytes sent: " & bytesSent
xmlHttp.Open "PUT", sUrl, False
xmlHttp.setRequestHeader "x-ms-blob-type", "BlockBlob"
xmlHttp.setRequestHeader "Content-Length", CStr(chunkSize)
Debug.Print "URL: " & sUrl
Debug.Print "Content-Length: " & CStr(chunkSize)
xmlHttp.send fileData
If xmlHttp.status <> 201 And xmlHttp.status <> 202 Then
Debug.Print "Error: " & xmlHttp.status & " - " & xmlHttp.StatusText
MsgBox "Error: " & xmlHttp.status & " - " & xmlHttp.StatusText, vbCritical
GoTo CleanUp
End If
bytesSent = bytesSent + chunkSize
Dim IntValue As Long
IntValue = (bytesSent \ chunkSize)
If IntValue >= 5 Then
IntValue = 5
End If
Set prg = Forms!dlgPRGBAR!CtlProgress.Object
Set Complete = Forms!dlgPRGBAR!lblComplete
prg.Max = numParts
prg.Value = IntValue
strComplete = Format((prg.Value / prg.Max) * 100, "##") & " % Complete"
Complete.Caption = strComplete
DoCmd.RepaintObject
Loop
adoStream.Close
DoCmd.Close acForm, "dlgPRGBAR"
responseStatus = xmlHttp.status
If responseStatus = 201 Then
MsgBox "File uploaded successfully!", vbInformation
Else
MsgBox "Error: " & responseStatus & " - " & xmlHttp.StatusText, vbCritical
End If
CleanUp:
On Error Resume Next
If Not adoStream Is Nothing Then adoStream.Close
Set adoStream = Nothing
Set xmlHttp = Nothing
Exit Sub
ErrHandler:
MsgBox "An error occurred: " & err.Description, vbCritical
Resume CleanUp
End Sub
According to the Azure documentation: “Partial updates are not supported with Put Blob. To perform a partial update of the content of a block blob, use the Put Block List operation.”
Unfortunately, I was unsuccessful with this method.
In the meantime, I explored using the Append Blob operation and successfully managed to partially upload a file. While this approach works, I'm unsure if it's the correct method to use, especially regarding incorporating a progress bar during the file upload.
Therefore, I would like to clarify the appropriate way to perform partial uploads to Azure. Should I use the Put Block List operation, or is it acceptable to use the Append Blob operation?
Below is a snippet demonstrating the use of the Append Blob operation;
Note: The new appending blob must be created as a new entry in the container; It cannot overwrite any existing blob;
Public Sub UploadToAzureAppendBlob(fileName As String, filePath As String)
Dim adoStream As Object
Dim xmlHttp As Object
Dim sUrl As String
Dim responseStatus As Long
Dim blockSize As Long
Dim totalSize As Long
Dim uploadedSize As Long
Dim chunkSize As Long
Dim chunkData As Variant
Dim progressPercent As Integer
Dim progressForm As Form
Dim numParts As Integer
Dim prg As progressBar
Dim fileSize As Long
Dim Complete As Label
On Error GoTo ErrHandler
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Type = 1
adoStream.Open
adoStream.LoadFromFile filePath
fileSize = adoStream.Size
uploadedSize = 0
Select Case fileSize
Case Is < CLng(512) * CLng(1024)
numParts = 2
Case Is < CLng(1) * CLng(1024) * CLng(1024)
numParts = 3
Case Else
numParts = 4
End Select
chunkSize = fileSize \ numParts
If chunkSize = 0 Then chunkSize = fileSize
' Check if the blob already exists
sUrl = BLOBURL & "/" & fileName & "?" & sasToken
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
With xmlHttp
.Open "HEAD", sUrl, False
.send
responseStatus = .status
End With
' If blob exists, delete it before uploading a new one
If responseStatus = 200 Then
If MsgBox("File Exists !!!" & vbCrLf & "Do you want to delete it?", vbInformation + vbYesNo + vbDefaultButton2, "INFO") = vbNo Then
GoTo CleanUp
End If
' Blob exists, delete it
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
With xmlHttp
.Open "DELETE", sUrl, False
.send
responseStatus = .status
End With
If responseStatus <> 202 Then
MsgBox "Error deleting existing blob: " & responseStatus, vbCritical
GoTo CleanUp
End If
End If
DoCmd.OpenForm "dlgPRGBAR"
Set progressForm = Forms!dlgPRGBAR
Set prg = progressForm!CtlProgress.Object
Set Complete = progressForm!lblComplete
Complete.Caption = "Starting upload..."
prg.Max = 100
prg.Value = 10
DoCmd.RepaintObject
DoEvents
sUrl = BLOBURL & "/" & URLEncodeJScript(fileName) & "?" & sasToken
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
With xmlHttp
.Open "PUT", sUrl, False
.setRequestHeader "x-ms-blob-type", "AppendBlob" ' Important: Specify the blob type
.send ""
responseStatus = .status
End With
If responseStatus <> 201 Then
MsgBox "Error creating append blob: " & responseStatus, vbCritical
GoTo CleanUp
End If
Do While uploadedSize < fileSize
If uploadedSize + chunkSize > fileSize Then
chunkSize = fileSize - uploadedSize
End If
adoStream.Position = uploadedSize
chunkData = adoStream.Read(chunkSize)
sUrl = BLOBURL & "/" & URLEncodeJScript(fileName) & "?comp=appendblock&" & sasToken
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
With xmlHttp
.Open "PUT", sUrl, False
.setRequestHeader "Content-Length", LenB(chunkData)
.send chunkData
responseStatus = .status
End With
If responseStatus = 201 Then
uploadedSize = uploadedSize + LenB(chunkData)
progressPercent = Int((uploadedSize / fileSize) * 100)
Debug.Print "Progress: " & progressPercent & "%"
prg.Max = 100
prg.Value = progressPercent
Complete.Caption = ""
DoCmd.RepaintObject
Complete.Caption = progressPercent & " % Complete"
DoCmd.RepaintObject
Else
MsgBox "Error uploading chunk: " & responseStatus, vbCritical
GoTo CleanUp
End If
Loop
MsgBox "File uploaded successfully!", vbInformation
CleanUp:
If Not adoStream Is Nothing Then adoStream.Close
Set adoStream = Nothing
Set xmlHttp = Nothing
On Error Resume Next
Set prg = Nothing
Set Complete = Nothing
Set progressForm = Nothing
DoCmd.Close acForm, "dlgPRGBAR"
Set progressForm = Nothing
Exit Sub
ErrHandler:
Debug.Print ERR.Number & " - " & ERR.Description & " File Size: " & fileSize
MsgBox "ERR.Number : " & ERR.Number & " - " & ERR.Description
Resume CleanUp
End Sub