Download Google Drive File from Excel Sheet using VBA - excel

Question

The hyperlink below appears in a cell in an Excel Sheet. It opens and displays a file if clicked on (permissions given to anyone with the link)
How can I download a linked file to a local folder using Excel vba?

Answer 1

URLDownloadToFile on Google Drive
The folder C:\Test has to exist for this example to work.
For more info on URLDownloadToFile try to search SO or Google.
The Code
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownLoadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Function downloadFile( _
ByVal FileURL As String, _
ByVal FilePath As String) _
As Boolean
Const ProcName As String = "downloadFile"
On Error GoTo clearError
URLDownloadToFile 0, FileURL, FilePath, 0, 0
downloadFile = True
ProcExit:
Exit Function
clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Function
Sub downloadGoogleDrive()
Const UrlLeft As String = "http://drive.google.com/u/0/uc?id="
Const UrlRight As String = "&export=download"
Const FileID As String = "17bw2KgzD1ifcA7rdXdxiN9bN70g8jnMO"
Const FilePath As String _
= "C:\Test\Type1 and Type 2 errors - Atyati Temp.jpg"
Dim Url As String: Url = UrlLeft & FileID & UrlRight
Dim wasDownloaded As Boolean
wasDownloaded = downloadFile(Url, FilePath)
If wasDownloaded Then
MsgBox "Success"
Else
MsgBox "Fail"
End If
End Sub

Answer 2

Download File from Google Drive with original file name
Sub DownloadGoogleDriveWithFilename()
Dim myOriginalURL As String
Dim myURL As String
Dim FileID As String
Dim xmlhttp As Object
Dim FolderPath As String
Dim FilePath As String
Dim name0 As Variant
Dim oStream As Object
Dim wasDownloaded As Boolean
Application.ScreenUpdating = False
''URL from share link or Google sheet URL or Google doc URL
myOriginalURL = "https://drive.google.com/file/d/1MnaC9-adPeEjkv7AEARchoYLLSWELBsy/view?usp=sharing"
FileID = Split(myOriginalURL, "/d/")(1) ''split after "/d/"
FileID = Split(FileID, "/")(0) ''split before "/"
Const UrlLeft As String = "http://drive.google.com/u/0/uc?id="
Const UrlRight As String = "&export=download"
myURL = UrlLeft & FileID & UrlRight
Debug.Print myURL
Set xmlhttp = CreateObject("winhttp.winhttprequest.5.1")
xmlhttp.Open "GET", myURL, False ', "username", "password"
xmlhttp.Send
name0 = xmlhttp.getResponseHeader("Content-Disposition")
If name0 = "" Then
MsgBox "file name not found"
Exit Sub
End If
Debug.Print name0
name0 = Split(name0, "=""")(1) ''split after "=""
name0 = Split(name0, """;")(0) ''split before "";"
' name0 = Replace(name0, """", "") ' Remove double quotes
Debug.Print name0
FolderPath = ThisWorkbook.path
FilePath = FolderPath & "\" & name0
''This part is equvualent to URLDownloadToFile(0, myURL, FolderPath & "\" & name0, 0, 0)
''just without having to write Windows API code for 32 bit and 64 bit.
If xmlhttp.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write xmlhttp.responseBody
oStream.SaveToFile FilePath, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
Application.ScreenUpdating = True
If FileExists(FilePath) Then
wasDownloaded = True
''open folder path location to look at the downloded file
Call Shell("explorer.exe" & " " & FolderPath, vbNormalFocus)
Else
wasDownloaded = False
MsgBox "failed"
End If
End Sub
Function FileExists(FilePath As String) As Boolean
Dim TestStr As String
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
If TestStr = "" Then
FileExists = False
Else
FileExists = True
End If
End Function