Selecting a file path in Excel VBA using FileOpen dialog

  • Thread starter Thread starter John Robinson
  • Start date Start date
J

John Robinson

I am trying to incorporate a facility in my application to select a
file path to enable the user to archive files to. Currently I have
been using the application.getopenfilename this works fine if there is
a file in the directory already as I can extract the path from that.
However if you create a new directory, with no file in, the open file
button greys out. Ideally I want to do it via a browse button to allow
the user to select the path. Is there a better way to do this? Can you
use the Windows openfile dialog instead of the Excel VBA one?
Many thanks in advance for any help.
John
 
Hi John

Try this:

Option Explicit

Enum BrowseForFolderFlags
BIF_RETURNONLYFSDIRS = &H1
BIF_DONTGOBELOWDOMAIN = &H2
BIF_STATUSTEXT = &H4
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_EDITBOX = &H10
BIF_RETURNFSANCESTORS = &H8
End Enum

Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long


Public Function BrowseForFolder(hWnd As Long, _
Optional Title As String, _
Optional Flags As BrowseForFolderFlags) As String

Dim iNull As Integer
Dim IDList As Long
Dim Result As Long
Dim Path As String
Dim bi As BrowseInfo

If Flags = 0 Then Flags = BIF_RETURNONLYFSDIRS
With bi
.lpszTitle = lstrcat(Title, "")
.ulFlags = Flags
End With

IDList = SHBrowseForFolder(bi)
If IDList Then
Path = String$(300, 0)
Result = SHGetPathFromIDList(IDList, Path)
iNull = InStr(Path, vbNullChar)
If iNull Then Path = Left$(Path, iNull - 1)
End If
BrowseForFolder = Path
End Function


Sub Test()
Dim sPath As String
sPath = BrowseForFolder(858, _
"Choose a folder:", BIF_DONTGOBELOWDOMAIN)
If sPath <> "" Then MsgBox sPath
End Sub
 
Back
Top