Beispiel:

Option Explicit
 
Public Enum CSIDL_FLAGS
  CSIDL_DESKTOP = &H0  ' (Desktop)
  CSIDL_INTERNET = &H1  ' Internet Explorer (Desktop)
  CSIDL_PROGRAMS = &H2  ' Startmenü\Programme
  CSIDL_CONTROLS = &H3  ' Arbeitsplatz\Systemsteuerung
  CSIDL_PRINTERS = &H4  ' Arbeitsplatz\Drucker
  CSIDL_PERSONAL = &H5  ' Eigene Dateien
  CSIDL_FAVORITES = &H6  ' (Benutzern.)\Favoriten
  CSIDL_STARTUP = &H7  ' Startmenü\Programme\Autostart
  CSIDL_RECENT = &H8  ' (Benutzern.)\Recent
  CSIDL_SENDTO = &H9  ' (Benutzern.)\SendTo
  CSIDL_BITBUCKET = &HA  ' (Desktop)\Papierkorb
  CSIDL_STARTMENU = &HB  ' (Benutzern.)\Startmenü
  CSIDL_DESKTOPDIRECTORY = &H10  ' (Benutzern.)\Desktop
  CSIDL_DRIVES = &H11  ' Arbeitsplatz
  CSIDL_NETWORK = &H12  ' Netzwerkumgebung
  CSIDL_NETHOOD = &H13  ' (Benutzern.)\Netzwerk(Umgebung)
  CSIDL_FONTS = &H14  ' Windows\Fonts
  CSIDL_TEMPLATES = &H15  ' (Benutzern.)\Vorlagen
  CSIDL_COMMON_STARTMENU = &H16  ' All Users\Startmenü
  CSIDL_COMMON_PROGRAMS = &H17  ' All Users\Programme
  CSIDL_COMMON_STARTUP = &H18  ' All Users\Autostart
  CSIDL_COMMON_DESKTOPDIRECTORY = &H19  ' All Users\Desktop
  CSIDL_APPDATA = &H1A  ' (Benutzern.)\Anwendungsdaten
  CSIDL_PRINTHOOD = &H1B  ' (Benutzern.)\Druckumgebung
  ' NT5! (BN)\Lokale Einstellungen\Anwendungsdaten
  CSIDL_LOCAL_APPDATA = &H1C
  ' (BN)\Lokale Einstellungen\Temporary Internet Files
  CSIDL_INTERNET_CACHE = &H20
  CSIDL_COOKIES = &H21  ' (Benutername)\Cookies
  ' (Benutzern.)\Lokale Einstellungen\Verlauf
  CSIDL_HISTORY = &H22
  ' NT5! All Users\Anwendungsdaten
  CSIDL_COMMON_APPDATA = &H23
  CSIDL_WINDOWS = &H24  ' NT5! Windowsverzeichnis
  CSIDL_SYSTEM = &H25  ' NT5! Systemverzeichnis
  CSIDL_PROGRAM_FILES = &H26  ' NT5! C:\Programme
  ' NT5! (Benutzern.)\Eigene Dateien\Eigene Bilder
  CSIDL_MYPICTURES = &H27
  CSIDL_PROFILE = &H28  ' NT5! (Benutzern.)
  ' NT5! C:\Programme\Gemeinsame Dateien
  CSIDL_PROGRAM_FILES_COMMON = &H2B
  CSIDL_COMMON_TEMPLATES = &H2D  ' All Users\Vorlagen
  CSIDL_COMMON_DOCUMENTS = &H2E  ' All Users\Dokumente
  ' NT5! All Users\Startmenü\Programme\Verwaltung
  CSIDL_COMMON_ADMINTOOLS = &H2F
  ' NT5! (Benutzern.)\Startmenü\Programme\Verwaltung
  CSIDL_ADMINTOOLS = &H30
End Enum
 
Public Type BROWSEINFO
  hOwner              As Long
  pidlRoot            As Long
  pszDisplayName      As String
  lpszTitle           As String
  ulFlags             As Long
  lpfn                As Long
  lParam              As Long
  iImage              As Long
End Type
 
Public Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion      As Long
  dwMinorVersion      As Long
  dwBuildNumber       As Long
  dwPlatformID        As Long
  szCSDVersion        As String * 128
End Type
 
Public Declare Sub CoTaskMemFree _
    Lib "OLE32.dll" (ByVal pv As Long)
Public Declare Function IsWindow _
    Lib "user32" _
    (ByVal hwnd As Long) As Long
Public Declare Function GetActiveWindow _
    Lib "user32" () As Long
Public Declare Function GetVersionEx _
    Lib "kernel32" Alias _
    "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function SHBrowseForFolder _
    Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList _
    Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
 
Public Function BrowseSpecialFolder( _
                lClsID As CSIDL_FLAGS, _
                sDisplayName As String, _
                Optional sTitle _
                As String = vbNullString, _
                Optional lhWnd As Long = 0, _
                Optional bDoEditBox _
                As Boolean = False, _
                Optional bDoIncludeFiles _
                As Boolean = False) As String
  '// -----------------------------------------------------
  '// Methode:   | Zeigt speziellen Ordnerdialog an.
  '// -----------------------------------------------------
  '// Parameter: | lClsID = Typ des Ordners
  '//            | sDisplayName = Variable für den
  '//            |                Listeneintrag
  '//            | lhWnd = Fenster-Handle (Bsp.: Me.hWnd)
  '//            | bDoEditBox = Erweitert den Dialog
  '//            |              um Web-Adressen
  '//            | bDoIncludeFiles = Erweitert den Dialog
  '//            |                   um Dateien
  '// -----------------------------------------------------
  '// Rückgabe:  | Kompletten Pfad
  '//            | optional sDisplayName: Listeneintrag
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel:
  '// Dim sDisplayName As String
  '// Dim sResult      As String
  '// sResult = _
   '// BrowseSpecialFolder(CSIDL_COOKIES, sDisplayName, _
   '//            "Bitte ein Cookie auswählen:", , , True)
  '// Debug.Print sResult; "; "; sDisplayName
  '// -----------------------------------------------------
  Const MAXPATH                   As Long = 260
  Const BIF_EDITBOX               As Long = &H10
  Const BIF_BROWSEINCLUDEFILES    As Long = &H4000
 
  Dim uBrwsInfo                   As BROWSEINFO
  Dim sPath                       As String
  Dim iOffset                     As Integer
  Dim pidl                        As Long
  Dim lBIF_Flags                  As Long
  Dim lMaxClsID                   As Long
 
  If IsWinNT5 Then
    lMaxClsID = 48
  Else: lMaxClsID = 34
  End If
  If lClsID > lMaxClsID Then Exit Function
  If (Not IsWinNT5) And (lClsID = CSIDL_LOCAL_APPDATA) _
      Then Exit Function
 
  If bDoEditBox Then lBIF_Flags = lBIF_Flags Or BIF_EDITBOX
  If bDoIncludeFiles Then lBIF_Flags = lBIF_Flags _
      Or BIF_BROWSEINCLUDEFILES
 
  If lhWnd <> 0 Then
    If Not IsWindow(lhWnd) Then lhWnd = GetActiveWindow()
  Else: lhWnd = GetActiveWindow()
  End If
  If Len(sTitle) = 0 Then sTitle = _
      "Bitte wählen Sie einen Eintrag aus:"
 
  With uBrwsInfo
    .hOwner = lhWnd
    .pidlRoot = lClsID
    .lpszTitle = sTitle
    .ulFlags = lBIF_Flags
    .pszDisplayName = Space$(MAXPATH)
  End With
  pidl = SHBrowseForFolder(uBrwsInfo)
 
  sPath = Space$(MAXPATH)
  If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
    '// Für virtuelle Ordner wird kein Pfad zurückgegeben
    iOffset = InStr(sPath, Chr$(0))
    If iOffset Then
      BrowseSpecialFolder = Left(sPath, iOffset - 1)
    Else: BrowseSpecialFolder = vbNullString
    End If
  End If
  '// Den "Display Name" (trotzdem) ermitteln
  iOffset = InStr(uBrwsInfo.pszDisplayName, Chr$(0))
  If iOffset Then
    sDisplayName = _
        Left(uBrwsInfo.pszDisplayName, iOffset - 1)
  End If
  Call CoTaskMemFree(pidl)
 
End Function
 
Public Property Get IsWinNT5() As Boolean
 
  Const VER_PLATFORM_WIN32_NT As Long = 2
  Dim uOSVer                  As OSVERSIONINFO
  uOSVer.dwOSVersionInfoSize = Len(uOSVer)
  GetVersionEx uOSVer
  IsWinNT5 = (uOSVer.dwPlatformID = _
      VER_PLATFORM_WIN32_NT) And _
      (uOSVer.dwMajorVersion = 5)
 
End Property