Public Sub httpclient()

    Dim token As String * 1024
    token = GetToken()
    SendFile "\\...\...xlsx", token
       
End Sub
Private Function GetToken() As String

Application.DisplayAlerts = False

    Const tokenUrl As String = "https://.../authenticate"
    Const userName As String = "Name1"
    Dim userPwd As String
    userPwd = InputBox("Укажите пароль:")

    Dim tokenRequest As String
    tokenRequest = "{""username"": """ & userName & """, ""password"": """ & userPwd & """}"
    
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", tokenUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "accept", "application/json"
        .send (tokenRequest)
'        MsgBox (.responseText)

'<<<<<<<<<<<<<< Формируем ответ в Outlook >>>>>>>>>>>>>>
' -----------------------------------------------------------------------------------------------------------------------
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
     
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon
    On Error GoTo cleanup  'если не запустился - выходим
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("A1").value 'адрес сообщения (Кому:)
        .Subject = Range("A2").value 'тема сообщения
        .Body = .responseText
'       Set .SendUsingAccount = .Session.Accounts.Item("Hotmail") ' отправка с другой учетной записи Outlook, если их несколько, при этом Hotmail - Hotmail - название требуемой учетной записи
        .send 'просмотр сообщения перед отправкой. Без просмотра - .Send
        GetToken = Mid(.responseText, 11, Len(.responseText) - 12)
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True ' открыть работу макроса

'----------------------------------------------
    End With
End Function


Private Sub SendFile(FileName As String, accessToken As String)

Application.DisplayAlerts = False

    Const fileType As String = "application/vnd.ms-excel"
    Const uploadUrl As String = "https://.../upload"
    Const Boundary = "---------------------------0123456789012"
    Const FieldName As String = "file"
    
    Dim FileContents, FormData
    
    FileContents = GetFile(FileName)
    FormData = BuildFormData(FileContents, Boundary, FileName, FieldName)
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", uploadUrl, False
        .setRequestHeader "Authorization", "Bearer " & accessToken
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
        .send (FormData)
'        MsgBox .Status
    End With
    
End Sub


Function GetFile(FileName As String)
  Dim Stream: Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 1 'Binary
  Stream.Open
  Stream.LoadFromFile FileName
  GetFile = Stream.Read
  Stream.Close
End Function


Function mpFields(FieldName, FileName, ContentType)
  Dim MPTemplate
  MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _
   " filename=""{file}""" + vbCrLf + _
   "Content-Type: {ct}" + vbCrLf + vbCrLf
  Dim Out
  Out = Replace(MPTemplate, "{field}", FieldName)
  Out = Replace(Out, "{file}", FileName)
  mpFields = Replace(Out, "{ct}", ContentType)
End Function


Function StringToMB(S)
  Dim i, B
  For i = 1 To Len(S)
    B = B & ChrB(Asc(Mid(S, i, 1)))
  Next
  StringToMB = B
End Function


Function BuildFormData(FileContents, Boundary, FileName, FieldName)
  Dim FormData, Pre, Po
  Const ContentType = "application/upload"
  
  Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, FileName, ContentType)
  Po = vbCrLf + "--" + Boundary + "--" + vbCrLf
  
  Const adLongVarBinary = 205
  Dim RS: Set RS = CreateObject("ADODB.Recordset")
  RS.Fields.Append "b", adLongVarBinary, Len(Pre) + LenB(FileContents) + Len(Po)
  RS.Open
  RS.AddNew
    Dim LenData
    LenData = Len(Pre)
    RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
    Pre = RS("b").GetChunk(LenData)
    RS("b") = ""
    LenData = Len(Po)
    RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
    Po = RS("b").GetChunk(LenData)
    RS("b") = ""
    RS("b").AppendChunk (Pre)
    RS("b").AppendChunk (FileContents)
    RS("b").AppendChunk (Po)
  RS.Update
  FormData = RS("b")
  RS.Close
  BuildFormData = FormData
End Function

MsgBox .Status

MsgBox (.responseText)

xmlhttp.SetTimeouts 3000000, 3000000, 3000000, 3000000

xmlhttp.send (ToByteArray(PostData))

"http://authentication-123.ru" -H "accept: application/json" -H "Content-Type: application/json" -d "{ "username": "login", "password": "string"}"

{
 "token": "eyJhbGciOiJIUzI1NiJ9.eyJ1c2VyRGF0YSI6eyJsb2dpbiI6InJ"
}

ActiveCell.Formula = "=INDEX('" & .[e6] & "SI'!$BE:$BE,MATCH(" & RC[23] & ",'" & .[e6] & "SI'!$BH:$BH,0))"