VBA PDF File Upload Using HTTP POST - vba

Question

I'm trying to upload a file to a .NET Core API using VBA code from a Word template. When the API receives the request, the file has a length of 0 and therefore any file I send to it becomes useless. I've uploaded files successfully to the same API using an Angular client instead of VBA, so I believe the problem lies within my VBA code. I've tested it with both .txt and .pdf files and the result is the same, 0 length file is received in the API (the end goal is to be able to upload a PDF file).
Do you see what's wrong with the code I'm using? Please see below. Any help is greatly appreciated.
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

Was able to make it work this way:
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