vba - 使用 VBA 和 MS XMLHTTP 将文件上传到 Azure Blob 存储

Question

我一直在尝试使用 Microsoft Access 中的 VBA 将文件上传到 Azure 存储，但到目前为止没有成功。

我进行了很好的搜索，发现了一些看起来很有希望的代码，但我无法让它工作。似乎许多其他人一直在寻找类似的解决方案或帮助通过 VBA 使用 Azure。

这是代码；

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

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

当我在表单中使用我的 azure 存储 URL 尝试此代码时

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

和文件名 (C:\Temp\Test.txt) 我收到以下错误；

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

我怀疑标题或发布数据中有问题，而不是 VBA，这不是我的领域。

非常感谢任何帮助。

Answer 1

我在搜索将图像上传到 Azure Blob 存储的相同答案时看到了这篇文章。我花了两天时间才得到答案。上面发布的代码确实帮助我部分解决了问题。

我想在这里发布我的解决方案，以防其他人正在寻找相同的答案。

在使用下面的代码之前，您需要从 Azure 门户(管理面板)获取共享 Access 签名 (SAS)。您应该能够在谷歌上搜索到这方面的答案。

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 是一个看起来像的 URL(我在中国，所以主机不同):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%2chN7Wpo 2nNtcn0pYRCU%4d

粗体字是您从 Azure 生成的 SAS token 。