reference "Google Drive" in code

[GraeagleBill]

Given the drive letter of the current environments "Google Drive" unknown to code, is there a way to reference the drive with just it's common name. E.g., "%Google Drive%\My Drive\MyFolder\MyFile.pdf" Or, is there a function that will give code the drive letter?

[Welshgasman]

https://www.google.com/search?q=get+...hrome&ie=UTF-8

https://www.google.com/search?q=get+...hrome&ie=UTF-8

[GraeagleBill]

I found one solution following the URL's you gave: (Daniel Pineault's comments suggests the code is copyrighted, so I'm not sure I can use it even for private use?)

Option Compare Database
Option Explicit


Private Sub DL()
MsgBox WMI_GetDriveByName("Google Drive")
End Sub




Public Function WMI_GetDriveByName(ByVal sDriveName As String) As String
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  Procedure : WMI_GetDriveByName
'  Author    : Daniel Pineault, CARDA Consultants Inc.
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    On Error GoTo Error_Handler
    #Const WMI_EarlyBind = False   'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oCols             As WbemScripting.SWbemObjectSet
        Dim oCol              As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oCols             As Object
        Dim oCol              As Object
        Const wbemFlagReturnImmediately = 16    '(&H10)
        Const wbemFlagForwardOnly = 32          '(&H20)
    #End If
    Dim sWMIQuery             As String         'WMI Query
 
    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sWMIQuery = "SELECT DeviceID FROM Win32_LogicalDisk WHERE VolumeName='" & sDriveName & "'"
    Set oCols = oWMI.ExecQuery(sWMIQuery, , wbemFlagReturnImmediately Or wbemFlagForwardOnly)
    For Each oCol In oCols
        WMI_GetDriveByName = oCol.DeviceID
        Exit For
    Next
 
Error_Handler_Exit:
    On Error Resume Next
    Set oCol = Nothing
    Set oCols = Nothing
    Set oWMI = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WMI_GetDriveByName" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) & _
            vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

[moke123]

I think you need an Api from google to access Google Drive. The name may be misleading as it's not really a drive on your machine.

[Welshgasman]

I found one solution following the URL's you gave: (Daniel Pineault's comments suggests the code is copyrighted, so I'm not sure I can use it even for private use?)

Option Compare Database
Option Explicit


Private Sub DL()
MsgBox WMI_GetDriveByName("Google Drive")
End Sub




Public Function WMI_GetDriveByName(ByVal sDriveName As String) As String
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  Procedure : WMI_GetDriveByName
'  Author    : Daniel Pineault, CARDA Consultants Inc.
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    On Error GoTo Error_Handler
    #Const WMI_EarlyBind = False   'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oCols             As WbemScripting.SWbemObjectSet
        Dim oCol              As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oCols             As Object
        Dim oCol              As Object
        Const wbemFlagReturnImmediately = 16    '(&H10)
        Const wbemFlagForwardOnly = 32          '(&H20)
    #End If
    Dim sWMIQuery             As String         'WMI Query
 
    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sWMIQuery = "SELECT DeviceID FROM Win32_LogicalDisk WHERE VolumeName='" & sDriveName & "'"
    Set oCols = oWMI.ExecQuery(sWMIQuery, , wbemFlagReturnImmediately Or wbemFlagForwardOnly)
    For Each oCol In oCols
        WMI_GetDriveByName = oCol.DeviceID
        Exit For
    Next
 
Error_Handler_Exit:
    On Error Resume Next
    Set oCol = Nothing
    Set oCols = Nothing
    Set oWMI = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WMI_GetDriveByName" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) & _
            vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Well I used code from the first link. I did tidy it somewhat for it's Dims.

C - Windows
D - WD Scorpio
E - Google Drive
F - DATA
G - DATA
J - \\PAULS\JAG Property
L - \\dlink323\Volume_1
M - \\dlink323\Volume_1\Music\Music_Collection
Y - \\DLINK323A\Volume_1
Z - \\Dlink323\usb250

[GraeagleBill]

For my specific purpose:

Function GetDriveLetter(VolName As String) As String
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  This drive letter find function only works with fixed volumes. A zero length
'  string is returned if the specified volume is not found among the collection.
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Const intFixed As Integer = 2
Dim fs, d, dc


GetDriveLetter = ""


Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives


    For Each d In dc
        If d.drivetype = intFixed Then
            If d.VolumeName = VolName Then GetDriveLetter = d.driveletter
        End If
    Next


End Function

[Welshgasman]

I see you did not tidy up the Dims.

[GraeagleBill]

Once one downloads the Google Drive App, it will then appear along with all the other drives:

[GraeagleBill]

My sense is that the Dims could use some additional qualifications beyond simply being objects?

Function GetDriveLetter(VolName As String) As String
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  This drive letter find function only works with fixed volumes. A zero length
'  string is returned if the specified volume is not found among the collection.
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Const intFixed As Integer = 2
Dim fs As Object
Dim d As Object
Dim dc As Object


GetDriveLetter = ""


Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives


    For Each d In dc
        If d.drivetype = intFixed Then
            If d.VolumeName = VolName Then GetDriveLetter = d.driveletter
        End If
    Next


End Function

[Welshgasman]

FWIW both my DATA volumes were USB sticks that were not present.

[isladogs]

Daniel's code is fairly standard. Anyone can use it.