VBA/Excel/Access/Word/File Path/Folder Dialog

Folder browser

   <source lang="vb">

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

</source>