使用HTTP POST上传VBA PDF文件

问题描述

我正在尝试使用Word模板中的VBA代码将文件上传到.NET Core API。当API收到请求时，文件的长度为0，因此我发送给它的任何文件都变得无用。我已经使用Angular客户端而不是VBA将文件成功上传到了相同的API，所以我相信问题出在我的VBA代码内。我已经对.txt和.pdf文件进行了测试，结果是相同的，API中收到的文件长度为0（最终目标是能够上传PDF文件）。

您看到我使用的代码出什么问题了吗？请看下面。任何帮助将不胜感激。

Sub UploadBinary()
    Const path = "C:\Users\REDACTED\VBA Upload Test\"
    Const fileName = "testfile.txt"
    Const CONTENT = "text/plain"
    Const URL = "https://localhost:44327/api/fileUpload"

    ' generate boundary
    Dim BOUNDARY,s As String,n As Integer
    For n = 1 To 16: s = s & Chr(65 + Int(Rnd * 25)): Next
    BOUNDARY = s & CDbl(Now)

    Dim part As String,ado As Object
    
    Dim header As String



    ' read file
    Dim FILE,FILESIZE
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile path & fileName
    ado.Position = 0
    FILESIZE = ado.Size
    FILE = ado.Read
    ado.Close
    
    
    
    Debug.Print "filesize",FILESIZE
    
    part = "--" & BOUNDARY & vbCrLf
    part = part & "Content-disposition: form-data; name=""file""; filename=""" & fileName & """" & vbCrLf
    part = part & "Content-Type: " & CONTENT & vbCrLf
    part = part & "Content-Length: " & FILESIZE & vbCrLf & vbCrLf & vbCrLf
    part = part & "--" & BOUNDARY & "--" & vbCrLf
    
    header = "Content-Type" & ": " & "multipart/form-data; boundary=" & BOUNDARY
    Debug.Print (header)
    Debug.Print (part)

    ' combine part,fl,end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write FILE
    ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "---")
    ado.Position = 0
    Debug.Print ado.Size
    'ado.savetofile "c:\tmp\debug.bin",2 ' overwrite

    ' send request
    'With CreateObject("WinHttp.WinHttpRequest.5.1")
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST",URL,False
        .SetRequestHeader "Content-Type","multipart/form-data; boundary=" & BOUNDARY
        .Send ado.Read
        ado.Close
        Debug.Print .ResponseText
    End With
End Sub

Function ToBytes(str As String) As Variant

    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.Read
    ado.Close

End Function

解决方法

能够以这种方式工作：

Public Sub UploadFile()
'Dim sFormData As String
Dim sFormData,bFormData
Dim d As String,DestURL As String,fileName As String,FilePath As String,FieldName As String
FieldName = "File"
DestURL = "https://localhost:44327/api/fileUpload"
'FileName = "testfile.txt"
'CONTENT = "text/plain"
fileName = "filename.pdf"
CONTENT = "application/pdf"
FilePath = "C:\path" & fileName


'Boundary of fields.
'Be sure this string is Not In the source file

Const Boundary As String = "---------------------------0123456789012"

Dim File,FILESIZE
Set ado = CreateObject("ADODB.Stream")
ado.Type = 1 'binary
ado.Open
ado.LoadFromFile FilePath
ado.Position = 0
FILESIZE = ado.Size
File = ado.Read
ado.Close


Set ado = CreateObject("ADODB.Stream")
d = "--" + Boundary + vbCrLf
d = d + "Content-Disposition: form-data; name=""" + FieldName + """;"
d = d + " filename=""" + fileName + """" + vbCrLf
d = d + "Content-Type: " & CONTENT + vbCrLf + vbCrLf
ado.Type = 1 'binary
ado.Open
ado.Write ToBytes(d)
ado.Write File
ado.Write ToBytes(vbCrLf + "--" + Boundary + "--" + vbCrLf)
ado.Position = 0


  With CreateObject("MSXML2.ServerXMLHTTP")
    .Open "POST",DestURL,False
    .SetRequestHeader "Content-Type","multipart/form-data; boundary=" & Boundary
    .Send ado.Read
    Debug.Print .ResponseText
End With

结束子

函数ToBytes（字符串形式的字符串）为变体形式

Dim ado As Object
Set ado = CreateObject("ADODB.Stream")
ado.Open
ado.Type = 2 ' text
ado.Charset = "_autodetect"
ado.WriteText str
ado.Position = 0
ado.Type = 1
ToBytes = ado.Read
ado.Close

结束功能