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
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):
All of the code: