VBA XMLHTTP POST Upload text/xml File to API Service

993 views Asked by At

I need to send XML file to API service with use of Excel/VBA.

Instructions available in documentation state that the only required field is:

file: string($binary) - file to upload. The name can be specified in the filename parameter of the Content-Disposition header.

This is the equivalent of CURL based on documentation:

    curl -X 'POST' \
    'api_service_url' \
    -H 'accept: */*' \
    -H 'Authorization: Bearer XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX=' \
    -H 'Content-Type: multipart/form-data' \
    -F '[email protected];type=text/xml'

I have searched the web and cannot find a working solution. I am wondering, if this is something possible to do with Excel VBA XMLHTTP library at all?

Available documentation of API service can be found on this link under the UPLOAD section:

https://testapi.valenciaportpcs.net/messaging/swagger/index.html

Any help or direction appreciated.

Code that is working for uploading the file, but having issues with UTF-8 special characters:

Option Explicit

Sub UploadFile()

Dim sFile As String
Dim sUrl As String
Dim sAccessToken As String
Dim sBoundary As String
Dim sResponse As String

    sFile = "D:\VPRT9000004726.xml"
    sUrl = "https://testapi.valenciaportpcs.net/messaging/messages/upload/default"
    sBoundary = "---------------------------166096475834725259111917034354"
    sAccessToken = "myaccesstoken"
    
    sResponse = pvPostFile(sUrl, sFile, sBoundary, sAccessToken)
    'Debug.Print sResponse

End Sub

Private Function pvPostFile(sUrl As String, sFileName As String, sBoundary As String, sAccessToken As String) As String

Dim xmlReq As MSXML2.ServerXMLHTTP60
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 = "--" & sBoundary & vbCrLf & _
        "Content-Disposition: form-data; name=""file""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: text/xml" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & sBoundary & "--"
    'Debug.Print sPostData
      
    '--- post
    Set xmlReq = New MSXML2.ServerXMLHTTP60
    With xmlReq
        .Open "POST", sUrl, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
        .setRequestHeader "Accept-Charset", "UTF-8"
        .send pvToByteArray(sPostData)
        pvPostFile = .Status
    End With
    Set xmlReq = Nothing
    
End Function
 
Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
0

There are 0 answers