VBA Modules: modSpecialFolders v1.00a

Read this for full information on these modules

modSpecialFolders reports back the path for a variety of "special folders" from Windows Shell32.  It's fairly standard and extremely useful code, great for deducing where to save output files and such.

This code is copied from Microsoft support site, I've just added my own annotations.

'modSpecialFolders
'v1.00a 2013-07-19 11:55
'always export to \\GBMNCWSA050\BPMpublic\VBA Modules\

'===========================================================================
' modSpecialFolders
'===========================================================================
'   Finds path to various "special folders" in Windows
'   e.g. My Documents, Program Files, Shared Documents, etc.

'===========================================================================
' Additional modules required:
'===========================================================================
'   None

'===========================================================================
' Additional References required:
'===========================================================================
'   None

'===========================================================================
' External applications required:
'===========================================================================
'   None

'=========================================================================
' VERSION HISTORY
'=========================================================================
'   v1.00a  annotations only
'   v1.00   created from source:
'           http://answers.microsoft.com/en-us/office/forum/office_2010-customize/how-2-refer-to-desktop/97eba910-54c9-409f-9454-6d7c8d54d009



Option Explicit

Public Declare Function SHGetSpecialFolderLocation _
                         Lib "shell32" (ByVal hwnd As Long, _
                                        ByVal nFolder As Long, ppidl As Long) As Long

Public Declare Function SHGetPathFromIDList _
                         Lib "shell32" Alias "SHGetPathFromIDListA" _
                             (ByVal Pidl As Long, ByVal pszPath As String) As Long

Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)

'Desktop
Public Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Public Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
Public Const CSIDL_PRINTERS = &H4 'My Computer\Printers
Public Const CSIDL_PERSONAL = &H5 'My Documents
Public Const CSIDL_FAVORITES = &H6 '\Favorites
Public Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
Public Const CSIDL_RECENT = &H8 '\Recent
Public Const CSIDL_SENDTO = &H9 '\SendTo
Public Const CSIDL_BITBUCKET = &HA '\Recycle Bin
Public Const CSIDL_STARTMENU = &HB '\Start Menu
Public Const CSIDL_DESKTOPDIRECTORY = &H10 '\Desktop
Public Const CSIDL_DRIVES = &H11 'My Computer
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood
Public Const CSIDL_NETHOOD = &H13 '\nethood
Public Const CSIDL_FONTS = &H14 'Windows\fonts
Public Const CSIDL_TEMPLATES = &H15
Public Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
Public Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
Public Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
Public Const CSIDL_APPDATA = &H1A '\Application Data
Public Const CSIDL_PRINTHOOD = &H1B '\PrintHood
Public Const CSIDL_LOCAL_APPDATA = &H1C '\Local Settings\Application Data (non roaming)
Public Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
Public Const CSIDL_COMMON_FAVORITES = &H1F
Public Const CSIDL_INTERNET_CACHE = &H20
Public Const CSIDL_COOKIES = &H21
Public Const CSIDL_HISTORY = &H22
Public Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
Public Const CSIDL_WINDOWS = &H24 'Windows Directory
Public Const CSIDL_SYSTEM = &H25 'System Directory
Public Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
Public Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
Public Const CSIDL_PROFILE = &H28 'USERPROFILE
Public Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
Public Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
Public Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
Public Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs\Administrative Tools
Public Const CSIDL_ADMINTOOLS = &H30 '\Start Menu\Programs\Administrative Tools
Public Const CSIDL_CONNECTIONS = &H31 'Network and Dial-up Connections
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String

strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
    lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
    If lngFolderFound Then
        SpecFolder = Left$(strPath, _
                           InStr(1, strPath, vbNullChar) - 1)
    End If
End If
CoTaskMemFree lngPidl
End Function