Obtain any user's Desktop path if OneDrive is a factor-CodePudding

I'm trying to obtain the desktop path in a situation where OneDrive may be a factor. Other simpler methods like Environ$("UserProfile") & "/Desktop" do not work. Here's what I've tried in a module:

Option Compare Database
Option Explicit


Private Declare PtrSafe Function SHGetKnownFolderPath Lib "shell32.dll" _
    (ByRef rfid As GUID, dwFlags As Long, hToken As Long, ByRef pszPath As Long) As Long

Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long


Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Const FOLDERID_Desktop As String = "{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}"

Public Function GetDesktopPath() As String
    Dim pszPath As Long
    Dim rfid As GUID
    Dim ret As Long

    rfid.Data1 = CLng(FOLDERID_Desktop)
    ret = SHGetKnownFolderPath(rfid, 0, 0, pszPath)

    If ret = 0 Then
        GetDesktopPath = StrConv(StrPtr(GlobalLock(pszPath)), vbUnicode)
        GlobalUnlock pszPath
    Else
        GetDesktopPath = ""
    End If
End Function

When I run this with debug.print GetDesktopPath(), I get a "Mismatch" error.

CodePudding user response：

Use the Shell Object

The easiest way of obtaining the Desktop path is using the Shell Object

Public Function GetDesktopPath() As String
    Dim oWSHShell As Object: Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop")
End Function

If you want to find any folder by its CLSID, you can use the following method:

Getting any special folders path by CLSID in VBA

I adapted this answer which is an adaption of the code from this original source.

'Get any special folders path by CLSID in VBA
'Authors:
'Original source from https://dbwiki.net/:
'    https://dbwiki.net/wiki/VBA_Tipp:_Spezielle_Verzeichnisse_ermitteln
'Adapted for VBA7 by Dietrich Baumgarten:
'    https://stackoverflow.com/a/62483749/12287457
'Further adapted for VBA6 and VBA7 compatibility by Guido Witt-Dörring:
'    https://stackoverflow.com/a/75102471/12287457

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As LongPtr, ByRef pGuid As GUID) As Long
    Private Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function SHGetKnownFolderPath Lib "shell32" (ByRef rfid As GUID, ByVal dwFlags As Long, ByVal hToken As Long, ByRef pszPath As LongPtr) As Long
    Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal length As Long)
#Else
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Long, pGuid As Any) As Long
    Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
    Private Declare Function SHGetKnownFolderPath Lib "shell32" (rfid As Any, ByVal dwFlags As Long, ByVal hToken As Long, ppszPath As Long) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
#End If

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const S_OK As Long = 0
Private Const WIN32_NULL As Long = 0

Private Const FOLDERID_Desktop As String = "{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}"

Private Function GetBstrFromWideStringPtr(ByVal lpwString As LongPtr) As String
    Dim length As Long

    If (lpwString) Then length = lstrlenW(lpwString)
    If (length) Then
        GetBstrFromWideStringPtr = Space$(length)
        CopyMemory StrPtr(GetBstrFromWideStringPtr), lpwString, length * 2
    End If
End Function

Private Function GetFolderPathByCLSID(ByVal FolderCLSID As String) As String
    'Returns empty String on any error.
    Dim ref As GUID
    #If VBA7 Then
        Dim pszPath As LongPtr
    #Else
        Dim pszPath As Long
    #End If
    
    If (CLSIDFromString(StrPtr(FolderCLSID), ref) = S_OK) Then
        If (SHGetKnownFolderPath(ref, 0, WIN32_NULL, pszPath) = S_OK) Then
            GetFolderPathByCLSID = GetBstrFromWideStringPtr(pszPath)
            CoTaskMemFree pszPath
        End If
    End If
End Function

Public Function GetDesktopPath() As String
    GetDesktopPath = GetFolderPathByCLSID(FOLDERID_Desktop)
End Function

For the sake of completeness, here is a list of other "special" folders CLSIDs:

Const FOLDERID_AddNewPrograms         As String = "{DE61D971-5EBC-4F02-A3A9-6C82895E5C04}"
Const FOLDERID_AdminTools             As String = "{724EF170-A42D-4FEF-9F26-B60E846FBA4F}"
Const FOLDERID_AppUpdates             As String = "{A305CE99-F527-492B-8B1A-7E76FA98D6E4}"
Const FOLDERID_CDBurning              As String = "{9E52AB10-F80D-49DF-ACB8-4330F5687855}"
Const FOLDERID_ChangeRemovePrograms   As String = "{DF7266AC-9274-4867-8D55-3BD661DE872D}"
Const FOLDERID_CommonAdminTools       As String = "{D0384E7D-BAC3-4797-8F14-CBA229B392B5}"
Const FOLDERID_CommonOEMLinks         As String = "{C1BAE2D0-10DF-4334-BEDD-7AA20B227A9D}"
Const FOLDERID_CommonPrograms         As String = "{0139D44E-6AFE-49F2-8690-3DAFCAE6FFB8}"
Const FOLDERID_CommonStartMenu        As String = "{A4115719-D62E-491D-AA7C-E74B8BE3B067}"
Const FOLDERID_CommonStartup          As String = "{82A5EA35-D9CD-47C5-9629-E15D2F714E6E}"
Const FOLDERID_CommonTemplates        As String = "{B94237E7-57AC-4347-9151-B08C6C32D1F7}"
Const FOLDERID_ComputerFolder         As String = "{0AC0837C-BBF8-452A-850D-79D08E667CA7}"
Const FOLDERID_ConflictFolder         As String = "{4BFEFB45-347D-4006-A5BE-AC0CB0567192}"
Const FOLDERID_ConnectionsFolder      As String = "{6F0CD92B-2E97-45D1-88FF-B0D186B8DEDD}"
Const FOLDERID_Contacts               As String = "{56784854-C6CB-462B-8169-88E350ACB882}"
Const FOLDERID_ControlPanelFolder     As String = "{82A74AEB-AEB4-465C-A014-D097EE346D63}"
Const FOLDERID_Cookies                As String = "{2B0F765D-C0E9-4171-908E-08A611B84FF6}"
Const FOLDERID_Desktop                As String = "{B4BFCC3A-DB2C-424C-B029-7FE99A87C641}"
Const FOLDERID_DeviceMetadataStore    As String = "{5CE4A5E9-E4EB-479D-B89F-130C02886155}"
Const FOLDERID_Documents              As String = "{FDD39AD0-238F-46AF-ADB4-6C85480369C7}"
Const FOLDERID_DocumentsLibrary       As String = "{7B0DB17D-9CD2-4A93-9733-46CC89022E7C}"
Const FOLDERID_Downloads              As String = "{374DE290-123F-4565-9164-39C4925E467B}"
Const FOLDERID_Favorites              As String = "{1777F761-68AD-4D8A-87BD-30B759FA33DD}"
Const FOLDERID_Fonts                  As String = "{FD228CB7-AE11-4AE3-864C-16F3910AB8FE}"
Const FOLDERID_Games                  As String = "{CAC52C1A-B53D-4EDC-92D7-6B2E8AC19434}"
Const FOLDERID_GameTasks              As String = "{054FAE61-4DD8-4787-80B6-090220C4B700}"
Const FOLDERID_History                As String = "{D9DC8A3B-B784-432E-A781-5A1130A75963}"
Const FOLDERID_HomeGroup              As String = "{52528A6B-B9E3-4ADD-B60D-588C2DBA842D}"
Const FOLDERID_ImplicitAppShortcuts   As String = "{BCB5256F-79F6-4CEE-B725-DC34E402FD46}"
Const FOLDERID_InternetCache          As String = "{352481E8-33BE-4251-BA85-6007CAEDCF9D}"
Const FOLDERID_InternetFolder         As String = "{4D9F7874-4E0C-4904-967B-40B0D20C3E4B}"
Const FOLDERID_Libraries              As String = "{1B3EA5DC-B587-4786-B4EF-BD1DC332AEAE}"
Const FOLDERID_Links                  As String = "{BFB9D5E0-C6A9-404C-B2B2-AE6DB6AF4968}"
Const FOLDERID_LocalAppData           As String = "{F1B32785-6FBA-4FCF-9D55-7B8E7F157091}"
Const FOLDERID_LocalAppDataLow        As String = "{A520A1A4-1780-4FF6-BD18-167343C5AF16}"
Const FOLDERID_LocalizedResourcesDir  As String = "{2A00375E-224C-49DE-B8D1-440DF7EF3DDC}"
Const FOLDERID_Music                  As String = "{4BD8D571-6D19-48D3-BE97-422220080E43}"
Const FOLDERID_MusicLibrary           As String = "{2112AB0A-C86A-4FFE-A368-0DE96E47012E}"
Const FOLDERID_NetHood                As String = "{C5ABBF53-E17F-4121-8900-86626FC2C973}"
Const FOLDERID_NetworkFolder          As String = "{D20BEEC4-5CA8-4905-AE3B-BF251EA09B53}"
Const FOLDERID_OriginalImages         As String = "{2C36C0AA-5812-4B87-BFD0-4CD0DFB19B39}"
Const FOLDERID_PhotoAlbums            As String = "{69D2CF90-FC33-4FB7-9A0C-EBB0F0FCB43C}"
Const FOLDERID_Pictures               As String = "{33E28130-4E1E-4676-835A-98395C3BC3BB}"
Const FOLDERID_PicturesLibrary        As String = "{A990AE9F-A03B-4E80-94BC-9912D7504104}"
Const FOLDERID_Playlists              As String = "{DE92C1C7-837F-4F69-A3BB-86E631204A23}"
Const FOLDERID_PrintersFolder         As String = "{76FC4E2D-D6AD-4519-A663-37BD56068185}"
Const FOLDERID_PrintHood              As String = "{9274BD8D-CFD1-41C3-B35E-B13F55A758F4}"
Const FOLDERID_Profile                As String = "{5E6C858F-0E22-4760-9AFE-EA3317B67173}"
Const FOLDERID_ProgramData            As String = "{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}"
Const FOLDERID_ProgramFiles           As String = "{905E63B6-C1BF-494E-B29C-65B732D3D21A}"
Const FOLDERID_ProgramFilesCommon     As String = "{F7F1ED05-9F6D-47A2-AAAE-29D317C6F066}"
Const FOLDERID_ProgramFilesCommonX64  As String = "{6365D5A7-0F0D-45e5-87F6-0DA56B6A4F7D}"
Const FOLDERID_ProgramFilesCommonX86  As String = "{DE974D24-D9C6-4D3E-BF91-F4455120B917}"
Const FOLDERID_ProgramFilesX64        As String = "{6D809377-6AF0-444b-8957-A3773F02200E}"
Const FOLDERID_ProgramFilesX86        As String = "{7C5A40EF-A0FB-4BFC-874A-C0F2E0B9FA8E}"
Const FOLDERID_Programs               As String = "{A77F5D77-2E2B-44C3-A6A2-ABA601054A51}"
Const FOLDERID_Public                 As String = "{DFDF76A2-C82A-4D63-906A-5644AC457385}"
Const FOLDERID_PublicDesktop          As String = "{C4AA340D-F20F-4863-AFEF-F87EF2E6BA25}"
Const FOLDERID_PublicDocuments        As String = "{ED4824AF-DCE4-45A8-81E2-FC7965083634}"
Const FOLDERID_PublicDownloads        As String = "{3D644C9B-1FB8-4F30-9B45-F670235F79C0}"
Const FOLDERID_PublicGameTasks        As String = "{DEBF2536-E1A8-4C59-B6A2-414586476AEA}"
Const FOLDERID_PublicLibraries        As String = "{48DAF80B-E6CF-4F4E-B800-0E69D84EE384}"
Const FOLDERID_PublicMusic            As String = "{3214FAB5-9757-4298-BB61-92A9DEAA44FF}"
Const FOLDERID_PublicPictures         As String = "{B6EBFB86-6907-413C-9AF7-4FC2ABF07CC5}"
Const FOLDERID_PublicRingtones        As String = "{E555AB60-153B-4D17-9F04-A5FE99FC15EC}"
Const FOLDERID_PublicVideos           As String = "{2400183A-6185-49FB-A2D8-4A392A602BA3}"
Const FOLDERID_QuickLaunch            As String = "{52A4F021-7B75-48A9-9F6B-4B87A210BC8F}"
Const FOLDERID_Recent                 As String = "{AE50C081-EBD2-438A-8655-8A092E34987A}"
Const FOLDERID_RecordedTVLibrary      As String = "{1A6FDBA2-F42D-4358-A798-B74D745926C5}"
Const FOLDERID_RecycleBinFolder       As String = "{B7534046-3ECB-4C18-BE4E-64CD4CB7D6AC}"
Const FOLDERID_ResourceDir            As String = "{8AD10C31-2ADB-4296-A8F7-E4701232C972}"
Const FOLDERID_Ringtones              As String = "{C870044B-F49E-4126-A9C3-B52A1FF411E8}"
Const FOLDERID_RoamingAppData         As String = "{3EB685DB-65F9-4CF6-A03A-E3EF65729F3D}"
Const FOLDERID_SampleMusic            As String = "{B250C668-F57D-4EE1-A63C-290EE7D1AA1F}"
Const FOLDERID_SamplePictures         As String = "{C4900540-2379-4C75-844B-64E6FAF8716B}"
Const FOLDERID_SamplePlaylists        As String = "{15CA69B3-30EE-49C1-ACE1-6B5EC372AFB5}"
Const FOLDERID_SampleVideos           As String = "{859EAD94-2E85-48AD-A71A-0969CB56A6CD}"
Const FOLDERID_SavedGames             As String = "{4C5C32FF-BB9D-43B0-B5B4-2D72E54EAAA4}"
Const FOLDERID_SavedSearches          As String = "{7D1D3A04-DEBB-4115-95CF-2F29DA2920DA}"
Const FOLDERID_SEARCH_CSC             As String = "{EE32E446-31CA-4ABA-814F-A5EBD2FD6D5E}"
Const FOLDERID_SEARCH_MAPI            As String = "{98EC0E18-2098-4D44-8644-66979315A281}"
Const FOLDERID_SearchHome             As String = "{190337D1-B8CA-4121-A639-6D472D16972A}"
Const FOLDERID_SendTo                 As String = "{8983036C-27C0-404B-8F08-102D10DCFD74}"
Const FOLDERID_SidebarDefaultParts    As String = "{7B396E54-9EC5-4300-BE0A-2482EBAE1A26}"
Const FOLDERID_SidebarParts           As String = "{A75D362E-50FC-4FB7-AC2C-A8BEAA314493}"
Const FOLDERID_StartMenu              As String = "{625B53C3-AB48-4EC1-BA1F-A1EF4146FC19}"
Const FOLDERID_Startup                As String = "{B97D20BB-F46A-4C97-BA10-5E3608430854}"
Const FOLDERID_SyncManagerFolder      As String = "{43668BF8-C14E-49B2-97C9-747784D784B7}"
Const FOLDERID_SyncResultsFolder      As String = "{289A9A43-BE44-4057-A41B-587A76D7E7F9}"
Const FOLDERID_SyncSetupFolder        As String = "{0F214138-B1D3-4A90-BBA9-27CBC0C5389A}"
Const FOLDERID_System                 As String = "{1AC14E77-02E7-4E5D-B744-2EB1AE5198B7}"
Const FOLDERID_SystemX86              As String = "{D65231B0-B2F1-4857-A4CE-A8E7C6EA7D27}"
Const FOLDERID_Templates              As String = "{A63293E8-664E-48DB-A079-DF759E0509F7}"
Const FOLDERID_UserPinned             As String = "{9E3995AB-1F9C-4F13-B827-48B24B6C7174}"
Const FOLDERID_UserProfiles           As String = "{0762D272-C50A-4BB0-A382-697DCD729B80}"
Const FOLDERID_UserProgramFiles       As String = "{5CD7AEE2-2219-4A67-B85D-6C9CE15660CB}"
Const FOLDERID_UserProgramFilesCommon As String = "{BCBD3057-CA5C-4622-B42D-BC56DB0AE516}"
Const FOLDERID_UsersFiles             As String = "{F3CE0F7C-4901-4ACC-8648-D5D44B04EF8F}"
Const FOLDERID_UsersLibraries         As String = "{A302545D-DEFF-464B-ABE8-61C8648D939B}"
Const FOLDERID_Videos                 As String = "{18989B1D-99B5-455B-841C-AB7C74E4DDFC}"
Const FOLDERID_VideosLibrary          As String = "{491E922F-5643-4AF4-A7EB-4E7A138D8174}"
Const FOLDERID_Windows                As String = "{F38BF404-1D43-42F2-9305-67DE0B28FC23}"

'Removed in Windows 7 SDK
'Const FOLDERID_RecordedTV            As String = "{BD85E001-112E-431E-983B-7B15AC09FFF1}"
'Const FOLDERID_TreeProperties        As String = "{5B3749AD-B49F-49C1-83EB-15370FBD4882}"