Search code examples
vbams-accessazurehttp-headersblob

Uploading a file to Azure Blob Storage using VBA and MS XMLHTTP


I've been trying to upload file to Azure storage using VBA in Microsoft Access but so far without success.

I have had a good search around and have found some code which looks promising but I can't get it to work. Seems like many others have been looking for a similar solution or help with working with Azure from VBA.

This is the code;

Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile           As Integer
Dim baBuffer()      As Byte
Dim sPostData       As String

'--- read file
nFile = FreeFile
Open sFileName For Binary Access Read As nFile
If LOF(nFile) > 0 Then
    ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
    Get nFile, , baBuffer
    sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
    "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
    "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
    sPostData & vbCrLf & _
    "--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
    .Open "POST", sUrl, bAsync
    .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
    .Send pvToByteArray(sPostData)
    If Not bAsync Then
        pvPostFile = .ResponseText
    End If
End With
End Sub

Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

(Thanks to - https://wqweto.wordpress.com/2011/07/12/vb6-using-wininet-to-post-binary-file/)

When I try this code using my azure storage URL in the form

https://XXXXX.blob.core.windows.net/ 

and a filename (C:\Temp\Test.txt) I get the following error;

<?xml version="1.0" encoding="utf-8"?><Error><Code>UnsupportedHttpVerb</Code><Message>The resource doesn't support specified Http Verb.

I suspect there's a problem in the header or post data rather than the VBA and this is not really my area.

Any help greatly appreciated.


Solution

  • I came across this post as I'm searching the same answer for uploading images to Azure Blob Storage. I took me 2 days to get the answer. And the code posted above did help me to partly solve the problem.

    I would like to post my solution here in case anyone else is looking for the same answer.

    Before you can use the code below, you need to get the Shared Access Signature (SAS) from your Azure portal (manage panel). You should be able to google the answers on this.

    Public Sub UploadAfIle(sUrl As String, sFileName As String)
        Dim adoStream As Object
        Set adoStream = CreateObject("ADODB.Stream")
        adoStream.Mode = 3          ' read write
        adoStream.Type = 1          ' adTypeBinary
        adoStream.Open
        adoStream.LoadFromFile (sFileName)
        With CreateObject("Microsoft.XMLHTTP")
            adoStream.Position = 0
            .Open "PUT", sUrl, False
            .setRequestHeader "Content-Length", "0" 'this is not a must
            .setRequestHeader "x-ms-blob-type", "BlockBlob"
            .Send adoStream.Read(adoStream.Size)
        End With
        Set adoStream = Nothing
    End Sub
    

    sURL is a URL looks like (I'm in China so the Host is different): https://myaccount.blob.core.chinacloudapi.cn/products/newimagename.jpg?sv=2016-05-31&ss=bfpq&srt=dco&sp=rydlscup&se=2017-07-30T18:40:26Z&st=2017-07-28T10:40:26Z&spr=https&sig=mJgDyECayITp0ivVrD4Oug%2Bz%2chN7Wpo2nNtcn0pYRCU%4d

    The one bolded is the SAS token you generated from Azure.