Option Explicit
Private Sub Combo1_Click()
Dim index As Long
index = Combo1.ItemData(Combo1.ListIndex)
If index > -1 Then
Text1.Text = GetSpecialFolderLocation(index)
End If
End Sub
Private Sub Form_Load()
With Combo1
.Font.Name = "Courier New"
.Font.Size = 9
.AddItem "CSIDL_DESKTOP {desktop}"
.ItemData(.NewIndex) = &H0
.AddItem "CSIDL_INTERNET Internet Explorer (icon on desktop)"
.ItemData(.NewIndex) = &H1
.AddItem "CSIDL_PROGRAMS Start Menu\Programs"
.ItemData(.NewIndex) = &H2
.AddItem "CSIDL_CONTROLS My Computer\Control Panel"
.ItemData(.NewIndex) = &H3
.AddItem "CSIDL_PRINTERS My Computer\Printers"
.ItemData(.NewIndex) = &H4
.AddItem "CSIDL_PERSONAL My Documents"
.ItemData(.NewIndex) = &H5
.AddItem "CSIDL_FAVORITES {user}\Favourites"
.ItemData(.NewIndex) = &H6
.AddItem "CSIDL_STARTUP Start Menu\Programs\Startup"
.ItemData(.NewIndex) = &H7
.AddItem "CSIDL_RECENT {user}\Recent"
.ItemData(.NewIndex) = &H8
.AddItem "CSIDL_SENDTO {user}\SendTo"
.ItemData(.NewIndex) = &H9
.AddItem "CSIDL_BITBUCKET {desktop}\Recycle Bin"
.ItemData(.NewIndex) = &HA
.AddItem "CSIDL_STARTMENU {user}\Start Menu"
.ItemData(.NewIndex) = &HB
.AddItem "CSIDL_DESKTOPDIRECTORY {user}\Desktop"
.ItemData(.NewIndex) = &H10
.AddItem "CSIDL_DRIVES My Computer"
.ItemData(.NewIndex) = &H11
.AddItem "CSIDL_NETWORK Network Neighbourhood"
.ItemData(.NewIndex) = &H12
.AddItem "CSIDL_NETHOOD {user}\nethood"
.ItemData(.NewIndex) = &H13
.AddItem "CSIDL_FONTS windows\fonts"
.ItemData(.NewIndex) = &H14
.AddItem "CSIDL_TEMPLATES"
.ItemData(.NewIndex) = &H15
.AddItem "CSIDL_COMMON_STARTMENU All Users\Start Menu"
.ItemData(.NewIndex) = &H16
.AddItem "CSIDL_COMMON_PROGRAMS All Users\Programs"
.ItemData(.NewIndex) = &H17
.AddItem "CSIDL_COMMON_STARTUP All Users\Startup"
.ItemData(.NewIndex) = &H18
.AddItem "CSIDL_COMMON_DESKTOPDIRECTORY All Users\Desktop"
.ItemData(.NewIndex) = &H19
.AddItem "CSIDL_APPDATA {user}\Application Data"
.ItemData(.NewIndex) = &H1A
.AddItem "CSIDL_PRINTHOOD {user}\PrintHood"
.ItemData(.NewIndex) = &H1B
.AddItem "CSIDL_LOCAL_APPDATA {user}\Local Settings\Application Data (non roaming)"
.ItemData(.NewIndex) = &H1C
.AddItem "CSIDL_ALTSTARTUP non localized startup"
.ItemData(.NewIndex) = &H1D
.AddItem "CSIDL_COMMON_ALTSTARTUP non localized common startup"
.ItemData(.NewIndex) = &H1E
.AddItem "CSIDL_COMMON_FAVORITES"
.ItemData(.NewIndex) = &H1F
.AddItem "CSIDL_INTERNET_CACHE"
.ItemData(.NewIndex) = &H20
.AddItem "CSIDL_COOKIES"
.ItemData(.NewIndex) = &H21
.AddItem "CSIDL_HISTORY"
.ItemData(.NewIndex) = &H22
.AddItem "CSIDL_COMMON_APPDATA All Users\Application Data"
.ItemData(.NewIndex) = &H23
.AddItem "CSIDL_WINDOWS GetWindowsDirectory()"
.ItemData(.NewIndex) = &H24
.AddItem "CSIDL_SYSTEM GetSystemDirectory()"
.ItemData(.NewIndex) = &H25
.AddItem "CSIDL_PROGRAM_FILES C:\Program Files"
.ItemData(.NewIndex) = &H26
.AddItem "CSIDL_MYPICTURES C:\Program Files\My Pictures"
.ItemData(.NewIndex) = &H27
.AddItem "CSIDL_PROFILE USERPROFILE"
.ItemData(.NewIndex) = &H28
.AddItem "CSIDL_SYSTEMX86 x86 system directory on RISC"
.ItemData(.NewIndex) = &H29
.AddItem "CSIDL_PROGRAM_FILESX86 x86 C:\Program Files on RISC"
.ItemData(.NewIndex) = &H2A
.AddItem "CSIDL_PROGRAM_FILES_COMMON C:\Program Files\Common"
.ItemData(.NewIndex) = &H2B
.AddItem "CSIDL_PROGRAM_FILES_COMMONX86 x86 Program Files\Common on RISC"
.ItemData(.NewIndex) = &H2C
.AddItem "CSIDL_COMMON_TEMPLATES All Users\Templates"
.ItemData(.NewIndex) = &H2D
.AddItem "CSIDL_COMMON_DOCUMENTS All Users\Documents"
.ItemData(.NewIndex) = &H2E
.AddItem "CSIDL_COMMON_ADMINTOOLS All Users\Start Menu\Programs\Administrative Tools"
.ItemData(.NewIndex) = &H2F
.AddItem "CSIDL_ADMINTOOLS {user}\Start Menu\Programs\Administrative Tools"
.ItemData(.NewIndex) = &H30
End With
End Sub
Private Function GetSpecialFolderLocation(CSIDL As Long) As String
Dim sPath As String
Dim pidl As Long
'fill the idl structure with the specified folder item
If SHGetSpecialFolderLocation(Me.hWnd, CSIDL, pidl) = S_OK Then
'if the pidl is returned, initialize
'and get the path from the id list
sPath = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
'return the path
GetSpecialFolderLocation = Left(sPath, InStr(sPath, Chr$(0)) - 1)
End If
'free the pidl
Call CoTaskMemFree(pidl)
End If
End Function
'--end block--'