2

To facilitate special folder processing, I wrote some code to return requested values based on an Enum with values for DeskTop, Default, MyDocuments, etc. The enum value is then converted to the appropriate string and processed by the code. The code works and returns expected values for all values except Default and MyDocuments. The Default and MyDocuments return an empty string. As a work-around for those two situations, I get the Environment Variable "UserProfile" + "\Documents" which works.

All of the enum values have a corresponding Get method that returns the value (e.g. GetFontsFolder, GetDeskTopFolder, etc). They all call in to a common function GetSpecialFolder shown below. Here are a couple examples:

' GetFontsFolder
Public Function GetFontsFolder(Optional bDebugging As Boolean = False) As String
    GetFontsFolder = GetSpecialFolder(SpecialFolders.Fonts, bDebugging)
End Function

' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
    GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function

Here is the code for MyDefaultFolder:

Private m_MyDefaultFolder As SpecialFolders

MyDefaultFolder = SpecialFolders.MyDocuments

Public Property Let MyDefaultFolder(eSpecialFolder As SpecialFolders)
    m_MyDefaultFolder = eSpecialFolder
End Property
Public Property Get MyDefaultFolder() As SpecialFolders
    MyDefaultFolder = m_MyDefaultFolder
End Property

Can someone explain why Default and MyDocuments return empty strings and everything else returns expected values? Is there a better way to get those values than using the UserProfile Environment Variable?

Here is the enum and function code:

Public Enum SpecialFolders
    ' Must always be the first value - 1
    ' Special case that will not show up in the list
    [_First] = -1
    None = 0
    Default
    AllUsersDesktop
    AllUsersStartMenu
    AllUsersPrograms
    AllUsersStartup
    Desktop
    Favorites
    Fonts
    MyDocuments
    NetHood
    PrintHood
    Programs
    Recent
    SendTo
    StartMenu
    Startup
    Templates
    ' Must always be the next to the last value + 1
    ' Special case that will not show up in the list
    [_Last] = Templates + 1
End Enum

Public Function GetSpecialFolder(Optional eSpecialFolder As SpecialFolders = SpecialFolders.Default, _
                                 Optional bDebugging As Boolean = False) As String
Dim WshShell As Object
Dim lIndex As Long
Dim sPath As String
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
    ' Must be variants, not strings or the code will not work.
    vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
    vSpecialFolderName = vSpecialFolderNames(eSpecialFolder)
    
    Set WshShell = CreateObject("WScript.Shell")
    If eSpecialFolder = SpecialFolders.Default Then
        vSpecialFolder = GetMyDefaultFolder
        If vSpecialFolder = vbNullString Then
            vSpecialFolder = Environ$("USERPROFILE") & "\Documents"
        End If
    Else
        vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
        If vSpecialFolder = vbNullString Then
            If eSpecialFolder = SpecialFolders.MyDocuments Then
                vSpecialFolder = Environ$("USERPROFILE") & "\Documents"
            End If
        End If
    End If
    
    ''For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
    ''    vSpecialFolderName = vSpecialFolderNames(lIndex)
    ''    sPath = WshShell.SpecialFolders(vSpecialFolderName)
    ''    Debug.Print lIndex; vSpecialFolderName; "  "; sPath; "  "; IIf(sPath = vbNullString, "*****", vbNullString)
    ''Next
    
    If bDebugging Then
        Debug.Print CStr(eSpecialFolder); ",  '"; vSpecialFolderName; "',  '"; vSpecialFolder; "'"
    End If
    
    GetSpecialFolder = vSpecialFolder
    Set WshShell = Nothing
End Function

' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
    GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function
3
  • If GetSpecialFolder returns nothing, it is because of vSpecialFolder, and vSpecialFolder gets its value from GetMyDefaultFolder. Please post the code for GetMyDefaultFolder.
    – Toddleson
    Commented Jun 15, 2022 at 13:37
  • Aren’t there better ways of doing this in VBA without relying on WScript.Shell? In VBA you have access to the Windows API.
    – user692942
    Commented Jun 15, 2022 at 19:15
  • @user692942 Would you mind posting a little bit of sample code? Commented Jun 15, 2022 at 20:23

1 Answer 1

1

If anyone is interested, here is the complete code for my cSpecialFolders class, part of which is referenced in my original question above. I expose enumeration values via ReadOnly Public Properties (e.g. DesktopFolder) as well as public Get methods (e.g. GetDeskTopFolder):

' Desktop
Public Property Get DesktopFolder() As String
    DesktopFolder = GetSpecialFolder(SpecialFolders.Desktop)
End Property

' GetDesktopFolder
Public Function GetDesktopFolder(Optional bDebugging As Boolean = False) As String
    GetDesktopFolder = GetSpecialFolder(SpecialFolders.Desktop, bDebugging)
End Function

All of the code:

Option Explicit

' Required References
'   1. Microsoft Scripting Runtime (scrrun.dll)

' Adapted
' From: WshShell.SpecialFolders
' Link: https://ss64.com/vb/special.html
' Also: An A-Z Index of Windows VBScript commands
' Link: https://ss64.com/vb/

' *************************
' **                     **
' ** SpecialFolders Enum **
' **                     **
' *************************
Public Enum SpecialFolders
    ' Must always be the first value - 1
    ' Special case that will not show up in the list
    [_First] = -1
    None = 0
    Default
    AllUsersDesktop
    AllUsersStartMenu
    AllUsersPrograms
    AllUsersStartup
    Desktop
    Favorites
    Fonts
    MyDocuments
    NetHood
    PrintHood
    Programs
    Recent
    SendTo
    StartMenu
    Startup
    Templates
    ' Must always be the next to the last value + 1
    ' Special case that will not show up in the list
    [_Last] = Templates + 1
End Enum

' ********************
' **                **
' ** Private Fields **
' **                **
' ********************

' Can be set in the constructor or via MyDefaultFolder property or SetMyDefaultFolder method.
Private m_MyDefaultFolder As SpecialFolders

Private Const m_DocumentsText As String = "\Documents"
Private Const m_UserProfileText As String = "USERPROFILE"

' Associated enumeration names. Excel does not provide these natively.
Private Const m_SpecialFolderNames As Variant = "None,Default,AllUsersDesktop,AllUsersStartMenu,AllUsersPrograms,AllUsersStartup,Desktop,Favorites,Fonts,MyDocuments,NetHood,PrintHood,Programs,Recent,SendTo,StartMenu,Startup,Templates"

' ********************************
' **                            **
' ** Public ReadOnly Properties **
' **                            **
' ********************************
Public Property Let MyDefaultFolder(eSpecialFolder As SpecialFolders)
    m_MyDefaultFolder = eSpecialFolder
End Property
Public Property Get MyDefaultFolder() As SpecialFolders
    MyDefaultFolder = m_MyDefaultFolder
End Property

' None
Public Property Get NoneFolder() As String
    NoneFolder = GetSpecialFolder(SpecialFolders.None)
End Property

' Default
Public Property Get DefaultFolder() As String
    DefaultFolder = GetSpecialFolder(SpecialFolders.Default)
End Property

' AllUsersDesktop
Public Property Get AllUsersDesktopFolder() As String
    AllUsersDesktopFolder = GetSpecialFolder(SpecialFolders.AllUsersDesktop)
End Property

' AllUsersStartMenu
Public Property Get AllUsersStartMenuFolder() As String
    AllUsersStartMenuFolder = GetSpecialFolder(SpecialFolders.AllUsersStartMenu)
End Property

' AllUsersPrograms
Public Property Get AllUsersProgramsFolder() As String
    AllUsersProgramsFolder = GetSpecialFolder(SpecialFolders.AllUsersPrograms)
End Property

' AllUsersStartup
Public Property Get AllUsersStartupFolder() As String
    AllUsersStartupFolder = GetSpecialFolder(SpecialFolders.AllUsersStartup)
End Property

' Desktop
Public Property Get DesktopFolder() As String
    DesktopFolder = GetSpecialFolder(SpecialFolders.Desktop)
End Property

' Favorites
Public Property Get FavoritesFolder() As String
    FavoritesFolder = GetSpecialFolder(SpecialFolders.Favorites)
End Property

' Fonts
Public Property Get FontsFolder() As String
    FontsFolder = GetSpecialFolder(SpecialFolders.Fonts)
End Property

' MyDocuments
Public Property Get MyDocumentsFolder() As String
    MyDocumentsFolder = GetSpecialFolder(SpecialFolders.MyDocuments)
End Property

' NetHood
Public Property Get NetHoodFolder() As String
    NetHoodFolder = GetSpecialFolder(SpecialFolders.NetHood)
End Property

' PrintHood
Public Property Get PrintHoodFolder() As String
    PrintHoodFolder = GetSpecialFolder(SpecialFolders.PrintHood)
End Property

' Programs
Public Property Get ProgramsFolder() As String
    ProgramsFolder = GetSpecialFolder(SpecialFolders.Programs)
End Property

' Recent
Public Property Get RecentFolder() As String
    RecentFolder = GetSpecialFolder(SpecialFolders.Recent)
End Property

' SendTo
Public Property Get SendToFolder() As String
    SendToFolder = GetSpecialFolder(SpecialFolders.SendTo)
End Property

' StartMenu
Public Property Get StartMenuFolder() As String
    StartMenuFolder = GetSpecialFolder(SpecialFolders.StartMenu)
End Property

' Startup
Public Property Get StartupFolder() As String
    StartupFolder = GetSpecialFolder(SpecialFolders.Startup)
End Property

' Templates
Public Property Get TemplatesFolder() As String
    TemplatesFolder = GetSpecialFolder(SpecialFolders.Templates)
End Property

' ******************************
' **                          **
' ** Constructor & Destructor **
' **                          **
' ******************************

Private Sub Class_Initialize()
    ' Setup the default folder.
    Me.MyDefaultFolder = SpecialFolders.MyDocuments
End Sub

' ************************
' **                    **
' ** Public Get Methods **
' **                    **
' ************************
Public Function GetSpecialFolder(Optional eSpecialFolder As SpecialFolders = SpecialFolders.Default, Optional bDebugging As Boolean = False) As String
Dim WshShell As Object
Dim lIndex As Long
Dim sPath As String
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
    ' Must be variants, not strings or the code will not work.
    vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
    vSpecialFolderName = vSpecialFolderNames(eSpecialFolder)
    
    Set WshShell = CreateObject("WScript.Shell")
    If eSpecialFolder = SpecialFolders.Default Then
        vSpecialFolder = GetMyDefaultFolder
        If vSpecialFolder = vbNullString Then
            vSpecialFolder = Environ$(m_UserProfileText) & m_DocumentsText
        End If
    Else
        vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
        If vSpecialFolder = vbNullString Then
            If eSpecialFolder = SpecialFolders.MyDocuments Then
                vSpecialFolder = Environ$(m_UserProfileText) & m_DocumentsText
            End If
        End If
    End If
    
    ''For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
    ''    vSpecialFolderName = vSpecialFolderNames(lIndex)
    ''    sPath = WshShell.SpecialFolders(vSpecialFolderName)
    ''    Debug.Print lIndex; vSpecialFolderName; "  "; sPath; "  "; IIf(sPath = vbNullString, "*****", vbNullString)
    ''Next
    
    If bDebugging Then
        Debug.Print CStr(eSpecialFolder); ",  '"; vSpecialFolderName; "',  '"; vSpecialFolder; "'"
    End If
    
    GetSpecialFolder = vSpecialFolder
    Set WshShell = Nothing
End Function

' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
    GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function

' SetMyDefaultFolder
Public Sub SetMyDefaultFolder(eSpecialFolder As SpecialFolders)
    MyDefaultFolder = eSpecialFolder
End Sub

' GetAllUsersDesktopFolder
Public Function GetAllUsersDesktopFolder(Optional bDebugging As Boolean = False) As String
    GetAllUsersDesktopFolder = GetSpecialFolder(SpecialFolders.AllUsersDesktop, bDebugging)
End Function

' GetAllUsersStartMenuFolder
Public Function GetAllUsersStartMenuFolder(Optional bDebugging As Boolean = False) As String
    GetAllUsersStartMenuFolder = GetSpecialFolder(SpecialFolders.AllUsersStartMenu, bDebugging)
End Function

' GetAllUsersProgramsFolder
Public Function GetAllUsersProgramsFolder(Optional bDebugging As Boolean = False) As String
    GetAllUsersProgramsFolder = GetSpecialFolder(SpecialFolders.AllUsersPrograms, bDebugging)
End Function

' GetAllUsersStartupFolder
Public Function GetAllUsersStartupFolder(Optional bDebugging As Boolean = False) As String
    GetAllUsersStartupFolder = GetSpecialFolder(SpecialFolders.AllUsersStartup, bDebugging)
End Function

' GetDesktopFolder
Public Function GetDesktopFolder(Optional bDebugging As Boolean = False) As String
    GetDesktopFolder = GetSpecialFolder(SpecialFolders.Desktop, bDebugging)
End Function

' GetFavoritesFolder
Public Function GetFavoritesFolder(Optional bDebugging As Boolean = False) As String
    GetFavoritesFolder = GetSpecialFolder(SpecialFolders.Favorites, bDebugging)
End Function

' GetFontsFolder
Public Function GetFontsFolder(Optional bDebugging As Boolean = False) As String
    GetFontsFolder = GetSpecialFolder(SpecialFolders.Fonts, bDebugging)
End Function

' GetMyDocumentsFolder
Public Function GetMyDocumentsFolder(Optional bDebugging As Boolean = False) As String
    GetMyDocumentsFolder = GetSpecialFolder(SpecialFolders.MyDocuments, bDebugging)
End Function

' GetNetHoodFolder
Public Function GetNetHoodFolder(Optional bDebugging As Boolean = False) As String
    GetNetHoodFolder = GetSpecialFolder(SpecialFolders.NetHood, bDebugging)
End Function

' GetPrintHoodFolder
Public Function GetPrintHoodFolder(Optional bDebugging As Boolean = False) As String
    GetPrintHoodFolder = GetSpecialFolder(SpecialFolders.PrintHood, bDebugging)
End Function

' GetProgramsFolder
Public Function GetProgramsFolder(Optional bDebugging As Boolean = False) As String
    GetProgramsFolder = GetSpecialFolder(SpecialFolders.Programs, bDebugging)
End Function

' GetRecentFolder
Public Function GetRecentFolder(Optional bDebugging As Boolean = False) As String
    GetRecentFolder = GetSpecialFolder(SpecialFolders.Recent, bDebugging)
End Function

' GetSendToFolder
Public Function GetSendToFolder(Optional bDebugging As Boolean = False) As String
    GetSendToFolder = GetSpecialFolder(SpecialFolders.SendTo, bDebugging)
End Function

' GetStartMenuFolder
Public Function GetStartMenuFolder(Optional bDebugging As Boolean = False) As String
    GetStartMenuFolder = GetSpecialFolder(SpecialFolders.StartMenu, bDebugging)
End Function

' GetStartupFolder
Public Function GetStartupFolder(Optional bDebugging As Boolean = False) As String
    GetStartupFolder = GetSpecialFolder(SpecialFolders.Startup, bDebugging)
End Function

' GetTemplatesFolder
Public Function GetTemplatesFolder(Optional bDebugging As Boolean = False) As String
    GetTemplatesFolder = GetSpecialFolder(SpecialFolders.Templates, bDebugging)
End Function

' **************************
' **                      **
' ** Other Public Methods **
' **                      **
' **************************
Public Function GetSpecialFoldersListDict() As Dictionary
Dim WshShell As Object
Dim oDict As Dictionary
Dim lIndex As Long
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
    Set WshShell = CreateObject("WScript.Shell")
    
    ' Key = SpecialFolders enum value, Value = Associated path
    Set oDict = New Dictionary
    
    ' Must be variants, not strings or the code will not work.
    vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
    For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
        vSpecialFolderName = vSpecialFolderNames(lIndex)
        If lIndex = SpecialFolders.Default Then
            vSpecialFolder = GetMyDefaultFolder
        Else
            vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
        End If
        
        ''Debug.Print lIndex, vSpecialFolderName, vSpecialFolder
        Call oDict.Add(lIndex, vSpecialFolder)
    Next
    
    Set GetSpecialFoldersListDict = oDict
    Set WshShell = Nothing
End Function

' *************************
' **                     **
' ** Simple Test Methods **
' **                     **
' *************************
Public Sub ListAllSpecialFolders()
    Debug.Print TypeName(SpecialFolders.MyDocuments)
    Debug.Print GetSpecialFolder(SpecialFolders.None, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Default, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.AllUsersDesktop, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.AllUsersStartMenu, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.AllUsersPrograms, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.AllUsersStartup, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Desktop, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Favorites, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Fonts, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.MyDocuments, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.NetHood, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.PrintHood, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Programs, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Recent, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.SendTo, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.StartMenu, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Startup, bDebugging:=True)
    Debug.Print GetSpecialFolder(SpecialFolders.Templates, bDebugging:=True)
End Sub

Private Sub TestGet()
    Debug.Print GetSpecialFolder(bDebugging:=True)
End Sub

' *******************
' **               **
' ** Sample Values **
' **               **
' *******************
'    0,  'None',  ''
'    1,  'Default',  ''
'    2,  'AllUsersDesktop',  'C:\Users\Public\Desktop
'    3,  'AllUsersStartMenu',  'C:\ProgramData\Microsoft\Windows\Start Menu'
'    4,  'AllUsersPrograms',  'C:\ProgramData\Microsoft\Windows\Start Menu\Programs'
'    6,  'Desktop',  'C:\Users\MyUserName\Desktop'
'    7,  'Favorites',  'C:\Users\MyUserName\Favorites'
'    8,  'Fonts',  'C:\Windows\Fonts'
'    9,  'MyDocuments',  'C:\Users\MyUserName\Documents'
'    10,  'NetHood',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Network Shortcuts'
'    11,  'PrintHood',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Printer Shortcuts'
'    12,  'Programs',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu\Programs'
'    13,  'Recent',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Recent'
'    14,  'SendTo',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\SendTo'
'    15,  'StartMenu',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu'
'    16,  'Startup',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup'
'    17,  'Templates',  'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Templates'

Not the answer you're looking for? Browse other questions tagged or ask your own question.