Retrieving User's Special Folders

This page describes VBA code that you can use to retrieve a user's special folders.

Introduction

On an operating system that supports multiple users, such as Windows XP or Windows Vista, each user of the system has his own data folder, called the User Profile Folder that contains folders such as My Documents and Desktop. The exact name and location of these folders vary depending on the version of Windows which you are using. This article describes two VB functions, GetUserProfileFolder and GetSpecialFolder that can be used to retrieve the specific folder names of the user's Profile Directory and of the special folders such as My Documents.

These procedures require the GetSystemErrorMessageText function available at the Get System Error Message Text page. This code is included in the downloadable zip file but not in the listing on this page.

Common Code

The following declarations are used by both functions and should be placed in the declarations section (before and outside of any procedures) of a code module.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API Declares
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long

Private Declare Function GetCurrentThread Lib "kernel32" () As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
    ByVal ProcessHandle As Long, _
    ByVal DesiredAccess As Long, _
    ByRef TokenHandle As Long) As Long

Private Declare Function SHGetFolderPath Lib "shell32.dll" Alias "SHGetFolderPathA" ( _
    ByVal HWnd As Long, _
    ByVal csidl As Long, _
    ByVal hToken As Long, _
    ByVal dwFlags As Long, _
    ByVal pszPath As String) As Long

Private Declare Function GetUserProfileDirectory Lib "userenv.dll" Alias "GetUserProfileDirectoryA" ( _
    ByVal hToken As Long, _
    ByVal lpProfileDir As String, _
    ByRef lpcchSize As Long) As Long

Private Declare Function FormatMessage Lib "kernel32" _
    Alias "FormatMessageA" ( _
    ByVal dwFlags As Long, _
    ByVal lpSource As Any, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, _
    ByVal nSize As Long, _
    ByRef Arguments As Long) As Long

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Misc Constants
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH = 260&
Private Const S_OK = 0&
Private Const E_INVALIDARG As Long = &H80070057
Private Const S_FALSE As Long = &H1 ' odd but true that S_FALSE would be 1.


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Used By OpenProcessToken and OpenProcess
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const TOKEN_QUERY As Long = &H8
Private Const TOKEN_QUERY_SOURCE As Long = &H10
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const TOKEN_READ As Long = (STANDARD_RIGHTS_READ Or TOKEN_QUERY)
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' used by FormatMessage
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Const FORMAT_MESSAGE_TEXT_LEN = &HA0


''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CSIDL Constants of various folder names.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const CSIDL_ADMINTOOLS As Long = &H30
Public Const CSIDL_ALTSTARTUP As Long = &H1D
Public Const CSIDL_APPDATA As Long = &H1A
Public Const CSIDL_BITBUCKET As Long = &HA
Public Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F
Public Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E
Public Const CSIDL_COMMON_APPDATA As Long = &H23
Public Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19
Public Const CSIDL_COMMON_DOCUMENTS As Long = &H2E
Public Const CSIDL_COMMON_FAVORITES As Long = &H1F
Public Const CSIDL_COMMON_PROGRAMS As Long = &H17
Public Const CSIDL_COMMON_STARTMENU As Long = &H16
Public Const CSIDL_COMMON_STARTUP As Long = &H18
Public Const CSIDL_COMMON_TEMPLATES As Long = &H2D
Public Const CSIDL_CONNECTIONS As Long = &H31
Public Const CSIDL_CONTROLS As Long = &H3
Public Const CSIDL_COOKIES As Long = &H21
Public Const CSIDL_DESKTOP As Long = &H0
Public Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Public Const CSIDL_DRIVES As Long = &H11
Public Const CSIDL_FAVORITES As Long = &H6
Public Const CSIDL_FLAG_CREATE As Long = &H8000
Public Const CSIDL_FLAG_DONT_VERIFY As Long = &H4000
Public Const CSIDL_FLAG_MASK As Long = &HFF00&
Public Const CSIDL_FLAG_PFTI_TRACKTARGET As Long = CSIDL_FLAG_DONT_VERIFY
Public Const CSIDL_FONTS As Long = &H14
Public Const CSIDL_HISTORY As Long = &H22
Public Const CSIDL_INTERNET As Long = &H1
Public Const CSIDL_INTERNET_CACHE As Long = &H20
Public Const CSIDL_LOCAL_APPDATA As Long = &H1C
Public Const CSIDL_MYPICTURES As Long = &H27
Public Const CSIDL_NETHOOD As Long = &H13
Public Const CSIDL_NETWORK As Long = &H12
Public Const CSIDL_PERSONAL As Long = &H5   ' My Documents
Public Const CSIDL_MY_DOCUMENTS As Long = &H5
Public Const CSIDL_PRINTERS As Long = &H4
Public Const CSIDL_PRINTHOOD As Long = &H1B
Public Const CSIDL_PROFILE As Long = &H28
Public Const CSIDL_PROGRAM_FILES As Long = &H26
Public Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B
Public Const CSIDL_PROGRAM_FILES_COMMONX86 As Long = &H2C
Public Const CSIDL_PROGRAM_FILESX86 As Long = &H2A
Public Const CSIDL_PROGRAMS As Long = &H2
Public Const CSIDL_RECENT As Long = &H8
Public Const CSIDL_SENDTO As Long = &H9
Public Const CSIDL_STARTMENU As Long = &HB
Public Const CSIDL_STARTUP As Long = &H7
Public Const CSIDL_SYSTEM As Long = &H25
Public Const CSIDL_SYSTEMX86 As Long = &H29
Public Const CSIDL_TEMPLATES As Long = &H15
Public Const CSIDL_WINDOWS As Long = &H24
Public Const PRIV_PAL_FUNC As Long = &H0
Public Const CSIR_FUNC As Long = (PRIV_PAL_FUNC Or &HD)

Public Function TrimToNull(Text As String) As String
    Dim N As Long
    N = InStr(1,Text,vbNullChar)
    If N Then 
        TrimToNull = Left(Text,N-1)
    Else
        TrimToNull = Text
    End If
End Function      

GetUserProfileFolder

The GetUserProfileFolder function returns the User Profile Folder name for the currently logged on user.

Public Function GetUserProfileFolder()

Dim Res As Long
Dim CurrentProcessHandle As Long
Dim TokenHandle As Long
Dim UserProfileDirectory As String
Dim LLen As Long
Dim Pos As Integer

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Initialize the string to receive the folder name
''''''''''''''''''''''''''''''''''''''''''''''''''''
UserProfileDirectory = String(MAX_PATH, " ")
LLen = Len(UserProfileDirectory)

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the pseudo-handle of the current process
''''''''''''''''''''''''''''''''''''''''''''''''''''
CurrentProcessHandle = GetCurrentProcess()

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Open the access token of the process
''''''''''''''''''''''''''''''''''''''''''''''''''''
Res = OpenProcessToken(CurrentProcessHandle, TOKEN_READ, TokenHandle)
If Res = 0 Then
    MsgBox "ERROR OpenProcessToken   " & CStr(Err.LastDllError) & " " & GetSystemErrorMessageText(Err.LastDllError)
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the user's directory
''''''''''''''''''''''''''''''''''''''''''''''''''''
Res = GetUserProfileDirectory(TokenHandle, UserProfileDirectory, LLen)
If Res = 0 Then
    CloseHandle CurrentProcessHandle
    CloseHandle TokenHandle
    MsgBox "ERROR GetUserProfileDirectory   " & CStr(Err.LastDllError) & " " & GetSystemErrorMessageText(Err.LastDllError)
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Trim to null char
''''''''''''''''''''''''''''''''''''''''''''''''''''
UserProfileDirectory = TrimToNull(Text:=UserProfileDirectory)


''''''''''''''''''''''''''''''''''''''''''''''''''''
'Close handles
''''''''''''''''''''''''''''''''''''''''''''''''''''
CloseHandle CurrentProcessHandle
CloseHandle TokenHandle

''''''''''''''''''''''''''''''''''''''''''''''''''''
' Return the result
''''''''''''''''''''''''''''''''''''''''''''''''''''
GetUserProfileFolder = UserProfileDirectory

End Function

GetSpecialFolder

The GetSpecialFolder function returns the one of the user's special folder such as My Documents. You specify which folder you want to retrieve by passing the appropriate CSIDL value from the list above.

Public Function GetSpecialFolder(FolderCSIDL As Long) As String

Dim HWnd As Long
Dim Path As String
Dim Res As Long
Dim ErrNumber As Long
Dim ErrText As String

''''''''''''''''''''''''''''''''''''''''''''
' initialize the path variable
''''''''''''''''''''''''''''''''''''''''''''
Path = String$(MAX_PATH, vbNullChar)

''''''''''''''''''''''''''''''''''''''''''''
' get the folder name
''''''''''''''''''''''''''''''''''''''''''''
Res = SHGetFolderPath(HWnd:=0&, _
                        csidl:=FolderCSIDL, _
                        hToken:=0&, _
                        dwFlags:=0&, _
                        pszPath:=Path)
Select Case Res
    Case S_OK
        Path = TrimToNull(Text:=Path)
        GetSpecialFolder = Path
    Case S_FALSE
        MsgBox "The folder code is valid but the folder does not exist."
        GetSpecialFolder = vbNullString
    Case E_INVALIDARG
        MsgBox "The value of FolderCSIDL is not valid."
        GetSpecialFolder = vbNullString
    Case Else
        ErrNumber = Err.LastDllError
        ErrText = GetSystemErrorMessageText(Res)
        MsgBox "An error occurred." & vbCrLf & _
            "System Error: " & CStr(ErrNumber) & vbCrLf & _
            "Description:  " & ErrText
End Select

End Function

You can download a bas module file containing all the code on this page.

This page last updated: 22-October-2007