ERLANDSEN DATA CONSULTING Excel & VBA Tips   Informasjon på norsk / Information in Norwegian

These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Select folder names

With the help of a couple of API-functions it's possible to display a dialog that lets the user select a folder:

Private Type BROWSEINFO ' used by the function GetFolderName
    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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder." 
        ' the dialog title
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetFolderName = Left(path, pos - 1)
        GetFolderName = ""
    End If
End Function

Sub TestGetFolderName()
Dim FolderName As String
    FolderName = GetFolderName("Select a folder")
    If FolderName = "" Then
        MsgBox "You didn't select a folder."
        MsgBox "You selected this folder: " & FolderName
    End If
End Sub


Document last updated 2000-02-04 12:49:08      Printerfriendly version


Erlandsen Data Consulting   
Excel & VBA Tips   Copyright ©1999-2018    Ole P. Erlandsen   All rights reserved
E-mail Contact Address