Folder browser : Folder Dialog « File Path « VBA / Excel / Access / Word

1. VBA / Excel / Access / Word
2. File Path
3. Folder Dialog

Folder browser

 

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  
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


Sub ListFiles()
    Msg = "Select a location containing the files you want to list."
    Directory = GetDirectory(Msg)
    If Directory = "" Then Exit Sub
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
    
    f = Dir(Directory, 7)
    Debug.Print f
    Debug.Print FileLen(Directory & f)
    Debug.Print FileDateTime(Directory & f)

    Do While f <> ""
        f = Dir
        If f <> "" Then
            Debug.Print f
            Debug.Print FileLen(Directory & f)
            Debug.Print FileDateTime(Directory & f)
        End If
    Loop
End Sub

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer

    bInfo.pidlRoot = 0&
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
  End If
    bInfo.ulFlags = &H1
    x = SHBrowseForFolder(bInfo)
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function

 

Related examples in the same category