使用 HTTP POST 上传 PDF 文件的 VBA

Question

我正在尝试使用 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

Answer 1

能够以这种方式工作:

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
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