I am trying to upload a local file to the google drive using vba and Google Drive Api. I am able to upload the file successfully and able to preview on the drive.
Only issue I have is , I don't know how/where to pass the filename. All my files saved as untitled by default.
Here is my code:
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
Result:
I checked this doc from Google but couldn't figure it out. Any help would be appriciated!
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