如何将元数据传递到 Google 驱动器 API 使用 VBA 上传

Question

我正在尝试使用 vba 和 Google Drive Api 将本地文件上传到 google 驱动器。我能够成功上传文件并能够在驱动器上预览。

我唯一的问题是，我不知道 how/where 传递文件名。我所有的文件都默认保存为无标题。

这是我的代码：

Sub GoogleDriveAPI()

Set req = New MSXML2.ServerXMLHTTP60
Dim content As Byte
Dim fPath As String
Dim Filename As String
    
fPath = Range("C5").Value

'Filename = "merged.pdf"

'arg = "{""name"": Filename}"

req.Open "POST", "https://www.googleapis.com/upload/drive/v3/files?uploadType=media", False
req.setRequestHeader "Authorization", "Bearer access-token"
req.setRequestHeader "Content-Type", "application/application/octet-stream"
req.setRequestHeader "Content-length", FileLen(fPath)
req.Send ReadByteArrFromFile(fPath)

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

结果：

我从 Google 中检查了 this doc，但无法弄清楚。如有任何帮助，我们将不胜感激！

Answer 1

构建分段上传

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

如何将元数据传递到 Google 驱动器 API 使用 VBA 上传

How to pass metadata to Google Drive API upload with VBA

excel

vba

google-drive-api