Get Special Folder

'Get Special Folder


Enum FOLDER

CSIDL_DESKTOP = &H0

CSIDL_ALLPROGRAMS = &H2

CSIDL_CONTROLS = &H3

CSIDL_PRINTERS = &H4

CSIDL_DOCUMENT = &H5

CSIDL_FAVORITES = &H6

CSIDL_STARTUP = &H7

CSIDL_RECENT = &H8

CSIDL_SENDTO = &H9

CSIDL_BITBUCKET = &HA

CSIDL_STARTMENU = &HB

CSIDL_MUSIC = &HD

CSIDL_VIDEO = &HE

CSIDL_DESKTOPDIRECTORY = &H10

CSIDL_DRIVES = &H11

CSIDL_NETWORK = &H12

CSIDL_NETHOOD = &H13

CSIDL_FONTS = &H14

CSIDL_TEMPLATES = &H15

CSIDL_ALLUSERSTARTMENU = &H16

CSIDL_ALLUSERALLPROGRAMS=&H17

CSIDL_ALLUSERSTARTUP=&H18

CSIDL_ALLUSERDESKTOP=&H19

CSIDL_ APPDATA=&H1A

CSIDL_PRINTHOOD=&H1B

CSIDL_LOCALSETTAPPDATA=&H1C

CSIDL_TEMP_INTERNET=&H20

CSIDL_COOKIES=&H21

CSIDL_HISTORY=&H22

CSIDL_ALLUSERAPPDATA=&H23

CSIDL_WINDOWS = &H24

CSIDL_SYSTEM = &H25

CSIDL_PROGRAMFILES=&H26

CSIDL_PICTURE=&H27

CSIDL_USER=&H28

CSIDL_COMMON=&H2B

CSIDL_ALLUSERTEMPLATE=&H2D

CSIDL_ALLUSERDOCUMENT=&H2E

CSIDL_ALLUSERADMTOOLS=&H2F

CSIDL_ADMTOOLS=&H30

CSIDL_ALLUSERMUSIC=&H35

CSIDL_ALLUSERPICTURE=&H36

CSIDL_ALLUSERVIDEO=&H37

CSIDL_RESOURCES=&H38

CSIDL_CDBURNING=&H3A

End Enum



Private Type SHITEMID

cb As Long

abID As Byte

End Type



Private Type ITEMIDLIST

myID 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



Private Sub Form_Load()



'Set the graphical mode to persistent

Me.AutoRedraw = True

'Print the folders to the form

Me.Print "Start Up folder : " + GetSpecialfolder(CSIDL_STARTUP)

Me.Print "Application Data  folder: " + GetSpecialfolder(CSIDL_ APPDATA)

Me.Print "Windows folder : " + GetSpecialfolder(CSIDL_WINDOWS)

Me.Print "Desktop folder : " + GetSpecialfolder(CSIDL_DESKTOP)

End Sub



Private Function GetSpecialfolder(CSIDL
As FOLDER) As String

Dim r As Long

Dim IDL As ITEMIDLIST

'Get the special folder

r = SHGetSpecialFolderLocation(100, CSIDL, IDL)

If r = NOERROR Then

'Create a buffer

Path$ = Space$(512)

'Get the path from the IDList

r = SHGetPathFromIDList(ByVal IDL.myID.cb, ByVal Path$)

'Remove the unnecessary chr$(0)'s

GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)

Exit Function

End If

GetSpecialfolder = ""

End Function