How to pass metadata to Google Drive API upload with VBA

Construct a multipart upload

Option Explicit

Sub GoogleDriveAPI()

    Const reqURL = "https://www.googleapis.com/upload/drive/v3/files?uploadType=multipart"
    Const TOKEN = "api-token"
    
    Dim content() As Byte, fPath As String, Filename As String
    Dim file_metadata As String
    
    fpath = "C:\path-to-file\" ' folder
    Filename = "merged.pdf"
    file_metadata = "{'name':'" & Filename & "'}"
        
    ' 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
   
    part = part & "--" & BOUNDARY & vbCrLf
    part = part & "Content-Type: application/json; charset=UTF-8" & vbCrLf
    part = part & "MIME-Version: 1.0" & vbCrLf & vbCrLf
    part = part & file_metadata & vbCrLf
    
    ' content
    part = part & "--" & BOUNDARY & vbCrLf
    part = part & "Content-Type: application/pdf" & vbCrLf
    part = part & "MIME-Version: 1.0" & vbCrLf
    part = part & "Content-Transfer-Encoding: binary" & vbCrLf & vbCrLf
    
    ' read  file as binary
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile fPath & Filename
    ado.Position = 0
    content = ado.read
    ado.Close

    ' combine part, csv , end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write content
    ado.Write ToBytes(vbCrLf & "--" & BOUNDARY & "---")
    ado.Position = 0

    Dim req As New MSXML2.XMLHTTP60
    With req
        .Open "POST", reqURL, False
        .setRequestHeader "Accept", "Application/json"
        .setRequestHeader "Authorization", "Bearer " & TOKEN
        .setRequestHeader "Content-Type", "multipart/related; boundary=" & BOUNDARY
        .send ado.read
    End With
    
    If req.Status = 200 Then '200 = OK
        Debug.Print req.responseText
        MsgBox ("Upload completed successfully")
    Else
        MsgBox req.Status & ": " & req.statusText
        Debug.Print req.responseText
    End If

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