Attribute VB_Name = "mod_SpecialFolders"
Option Explicit
'
Private Const CSIDL_DESKTOP                     As Long = &H0
Private Const CSIDL_INTERNET                    As Long = &H1
Private Const CSIDL_PROGRAMS                    As Long = &H2
Private Const CSIDL_CONTROLS                    As Long = &H3
Private Const CSIDL_PRINTERS                    As Long = &H4
Private Const CSIDL_PERSONAL                    As Long = &H5
Private Const CSIDL_FAVORITES                   As Long = &H6
Private Const CSIDL_STARTUP                     As Long = &H7
Private Const CSIDL_RECENT                      As Long = &H8
Private Const CSIDL_SENDTO                      As Long = &H9
Private Const CSIDL_BITBUCKET                   As Long = &HA
Private Const CSIDL_STARTMENU                   As Long = &HB
Private Const CSIDL_MYDOCUMENTS                 As Long = &HC
Private Const CSIDL_MYMUSIC                     As Long = &HD
Private Const CSIDL_MYVIDEO                     As Long = &HE
Private Const CSIDL_DESKTOPDIRECTORY            As Long = &H10
Private Const CSIDL_DRIVES                      As Long = &H11
Private Const CSIDL_NETWORK                     As Long = &H12
Private Const CSIDL_NETHOOD                     As Long = &H13
Private Const CSIDL_FONTS                       As Long = &H14
Private Const CSIDL_TEMPLATES                   As Long = &H15
Private Const CSIDL_COMMON_STARTMENU            As Long = &H16
Private Const CSIDL_COMMON_PROGRAMS             As Long = &H17
Private Const CSIDL_COMMON_STARTUP              As Long = &H18
Private Const CSIDL_COMMON_DESKTOPDIRECTORY     As Long = &H19
Private Const CSIDL_APPDATA                     As Long = &H1A
Private Const CSIDL_PRINTHOOD                   As Long = &H1B
Private Const CSIDL_LOCAL_APPDATA               As Long = &H1C
Private Const CSIDL_ALTSTARTUP                  As Long = &H1D
Private Const CSIDL_COMMON_ALTSTARTUP           As Long = &H1E
'
Private Const CSIDL_COMMON_FAVORITES            As Long = &H1F
Private Const CSIDL_INTERNET_CACHE              As Long = &H20
Private Const CSIDL_COOKIES                     As Long = &H21
Private Const CSIDL_HISTORY                     As Long = &H22
Private Const CSIDL_COMMON_APPDATA              As Long = &H23
Private Const CSIDL_WINDOWS                     As Long = &H24
Private Const CSIDL_SYSTEM                      As Long = &H25
Private Const CSIDL_PROGRAM_FILES               As Long = &H26
Private Const CSIDL_MYPICTURES                  As Long = &H27
Private Const CSIDL_PROFILE                     As Long = &H28
Private Const CSIDL_PROGRAM_FILES_COMMON        As Long = &H2B
Private Const CSIDL_COMMON_TEMPLATES            As Long = &H2D
Private Const CSIDL_COMMON_DOCUMENTS            As Long = &H2E
Private Const CSIDL_COMMON_ADMINTOOLS           As Long = &H2F
Private Const CSIDL_ADMINTOOLS                  As Long = &H30
Private Const CSIDL_CONNECTIONS                 As Long = &H31
Private Const CSIDL_COMMON_MUSIC                As Long = &H35
Private Const CSIDL_COMMON_PICTURES             As Long = &H36
Private Const CSIDL_COMMON_VIDEO                As Long = &H37
Private Const CSIDL_RESOURCES                   As Long = &H38
Private Const CSIDL_RESOURCES_LOCALIZED         As Long = &H39
Private Const CSIDL_COMMON_OEM_LINKS            As Long = &H3A
Private Const CSIDL_CDBURN_AREA                 As Long = &H3B
Private Const CSIDL_COMPUTERSNEARME             As Long = &H3D
'
Public Enum SpecialFolders
    '
    Desktop = CSIDL_DESKTOP
    Internet = CSIDL_INTERNET
    Programs = CSIDL_PROGRAMS
    Controls = CSIDL_CONTROLS
    Printers = CSIDL_PRINTERS
    Personal = CSIDL_PERSONAL
    Favorites = CSIDL_FAVORITES
    Startup = CSIDL_STARTUP
    Recent = CSIDL_RECENT
    SendTo = CSIDL_SENDTO
    BitBucket = CSIDL_BITBUCKET
    StartMenu = CSIDL_STARTMENU
    MyDocuments = CSIDL_MYDOCUMENTS
    MyMusic = CSIDL_MYMUSIC
    MyVideo = CSIDL_MYVIDEO
    DesktopDirectory = CSIDL_DESKTOPDIRECTORY
    Drives = CSIDL_DRIVES
    Network = CSIDL_NETWORK
    NetHood = CSIDL_NETHOOD
    Fonts = CSIDL_FONTS
    Templates = CSIDL_TEMPLATES
    Common_StartMenu = CSIDL_COMMON_STARTMENU
    Common_Programs = CSIDL_COMMON_PROGRAMS
    Common_Startup = CSIDL_COMMON_STARTUP
    Common_DesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
    AppData = CSIDL_APPDATA
    PrintHood = CSIDL_PRINTHOOD
    Local_AppData = CSIDL_APPDATA
    AltStartup = CSIDL_ALTSTARTUP
    Common_AltStartup = CSIDL_COMMON_ALTSTARTUP
    '
    Common_Favorites = CSIDL_COMMON_FAVORITES
    Internet_Cache = CSIDL_INTERNET_CACHE
    Cookies = CSIDL_COOKIES
    History = CSIDL_HISTORY
    Common_ApPData = CSIDL_COMMON_APPDATA
    Windows = CSIDL_WINDOWS
    System = CSIDL_SYSTEM
    Program_Files = CSIDL_PROGRAM_FILES
    MyPictures = CSIDL_MYPICTURES
    Profile = CSIDL_PROFILE
    Program_Files_Common = CSIDL_PROGRAM_FILES_COMMON
    Common_Program_Files = CSIDL_PROGRAM_FILES_COMMON
    Common_Templates = CSIDL_COMMON_TEMPLATES
    Common_Documents = CSIDL_COMMON_DOCUMENTS
    Common_AdminTools = CSIDL_COMMON_ADMINTOOLS
    AdminTools = CSIDL_ADMINTOOLS
    Connections = CSIDL_CONNECTIONS
    Common_Music = CSIDL_COMMON_MUSIC
    Common_Pictures = CSIDL_COMMON_PICTURES
    Common_Video = CSIDL_COMMON_VIDEO
    Resources = CSIDL_RESOURCES
    Resources_Localized = CSIDL_RESOURCES_LOCALIZED
    Common_OEM_Links = CSIDL_COMMON_OEM_LINKS
    CDBurn_Area = CSIDL_CDBURN_AREA
    ComputersNearMe = CSIDL_COMPUTERSNEARME
    '
End Enum
'
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
'
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'

Public Function GetSpecialfolder(CSIDL As Long) As String
    '
    Dim r As Long
    Dim IDL As ITEMIDLIST
    Dim strPath As String
    '
    Const NOERROR = 0
    'Const MAX_LENGTH = 260
    '
    r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If r = NOERROR Then
        strPath = Space$(512)
        r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
        GetSpecialfolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
    End If
    '
End Function