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'
GetSpecialFolder
returns nothing, it is because ofvSpecialFolder
, andvSpecialFolder
gets its value fromGetMyDefaultFolder
. Please post the code forGetMyDefaultFolder
.WScript.Shell
? In VBA you have access to the Windows API.