VB and VBA Users Source Code: Determining a users special folder locations (eg Application Directory or Desktop Directory)
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Determining a users special folder locations (eg Application Directory or Desktop Directory)
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, January 15, 2001
Hits:
619
Category:
Windows API
Article:
Listed below is a routine which is useful when trying to determine the location of specific system folder/s (eg. the location of the favourites, desktop, start menu folders etc). Note, to determine the location of the windows system folder, use the following article: http://www.vbusers.com/code/codeget.asp?ThreadID=159&PostID=1&NumReplies=0 Option Explicit Public Enum epPath CSIDL_DESKTOP = &H0 CSIDL_INTERNET = &H1 CSIDL_PROGRAMS = &H2 CSIDL_CONTROLS = &H3 CSIDL_PRINTERS = &H4 CSIDL_PERSONAL = &H5 CSIDL_FAVORITES = &H6 CSIDL_STARTUP = &H7 CSIDL_RECENT = &H8 CSIDL_SENDTO = &H9 CSIDL_BITBUCKET = &HA CSIDL_STARTMENU = &HB CSIDL_DESKTOPDIRECTORY = &H10 CSIDL_DRIVES = &H11 CSIDL_NETWORK = &H12 CSIDL_NETHOOD = &H13 CSIDL_FONTS = &H14 CSIDL_TEMPLATES = &H15 CSIDL_COMMON_STARTMENU = &H16 CSIDL_COMMON_PROGRAMS = &H17 CSIDL_COMMON_STARTUP = &H18 CSIDL_COMMON_DESKTOPDIRECTORY = &H19 CSIDL_APPDATA = &H1A CSIDL_PRINTHOOD = &H1B CSIDL_LOCAL_APPDATA = &H1C CSIDL_ALTSTARTUP = &H1D CSIDL_COMMON_ALTSTARTUP = &H1E CSIDL_COMMON_FAVORITES = &H1F CSIDL_INTERNET_CACHE = &H20 CSIDL_COOKIES = &H21 CSIDL_HISTORY = &H22 CSIDL_COMMON_APPDATA = &H23 CSIDL_WINDOWS = &H24 CSIDL_SYSTEM = &H25 CSIDL_PROGRAM_FILES = &H26 CSIDL_MYPICTURES = &H27 CSIDL_PROFILE = &H28 CSIDL_SYSTEMX86 = &H29 CSIDL_PROGRAM_FILESX86 = &H2A CSIDL_PROGRAM_FILES_COMMON = &H2B CSIDL_PROGRAM_FILES_COMMONX86 = &H2C CSIDL_COMMON_TEMPLATES = &H2D CSIDL_COMMON_DOCUMENTS = &H2E CSIDL_COMMON_ADMINTOOLS = &H2F CSIDL_ADMINTOOLS = &H30 CSIDL_FLAG_CREATE = &H8000& CSIDL_FLAG_DONT_VERIFY = &H4000 CSIDL_FLAG_MASK = &HFF00 End Enum Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Type SHITEMID CB As Long AbID As Byte End Type Private Type ITEMIDLIST Mkid As SHITEMID End Type Public Type SpecialFolder FolderPath As String FolderType As epPath End Type 'Purpose : Returns an array of special folders 'Inputs : 'Outputs : Returns an array of the special folders. 'Author : Andrew Baker 'Date : 15/01/2001 22:16 'Notes : 'Revisions : Function GetAllSpecialFolders() As SpecialFolder() Dim lThisFolder As Long, lNumFolders As Long Dim sFolderPath As String Dim resultArray() As SpecialFolder Const clMaxFolders As Long = 255 On Error GoTo ErrFailed Erase resultArray 'Return All Folders ReDim resultArray(1 To clMaxFolders) For lThisFolder = 0 To clMaxFolders sFolderPath = UCase$(GetSpecialFolder(lThisFolder)) If Len(sFolderPath) Then lNumFolders = lNumFolders + 1 resultArray(lNumFolders).FolderPath = sFolderPath resultArray(lNumFolders).FolderType = lThisFolder End If Next If lNumFolders Then ReDim Preserve resultArray(1 To lNumFolders) GetAllSpecialFolders = resultArray Else GetAllSpecialFolders = Empty End If Exit Function ErrFailed: GetAllSpecialFolders = Empty End Function Function GetSpecialFolder(eFolderID As epPath) As String Dim tRetVal As Long, sBuffer As String Dim tIDL As ITEMIDLIST Const NO_ERROR = 0 'Get the special folder tRetVal = SHGetSpecialFolderLocation(100&, eFolderID, tIDL) If tRetVal = NO_ERROR Then 'Create a buffer sBuffer = Space$(512) 'Get the path from the IDList tRetVal = SHGetPathFromIDList(ByVal tIDL.Mkid.CB, ByVal sBuffer) 'Remove the unnecesarry chr$(0)'s GetSpecialFolder = Left$(sBuffer, InStr(1, sBuffer, vbNullChar) - 1) If Right$(GetSpecialFolder, 1) <> "\" And Len(GetSpecialFolder) > 0 Then GetSpecialFolder = GetSpecialFolder & "\" End If End If End Function 'Demonstration routine Sub Test() Dim atFolders() As SpecialFolder, tFolder As SpecialFolder, folder As Integer 'Get all special folders atFolders = GetAllSpecialFolders() For folder = 1 To UBound(atFolders) tFolder = atFolders(folder) Debug.Print "Type: " & tFolder.FolderType & ". Path: " & tFolder.FolderPath Next 'Get the start menu folder location Debug.Print GetSpecialFolder(CSIDL_STARTMENU) End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
