Solved: Folder path

[ukdane]

I'm aware of the dialog that opens, so that the user can select a file.
Application.GetOpenFilename.Show

But, I need the user to only select a folder. The selected folder will then be used by Excel VBA to create a hyperlink to the folder.

Any ideas?

[Bob Phillips]

Sub GetFolder()

Dim lngCount As Long

' Open the file dialog
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then

MsgBox .SelectedItems(1)
End If
End With

End Sub

[ukdane]

Hi,
I just tried:

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
If .Show = -1 Then

MsgBox .SelectedItems(1)
End If
End With

But it doesn't work, I get a runtime error 438.
'Object doesn't support this property or method.'

I'm running Excel 2000.

[Bob Phillips]

what excel version?

[Kenneth Hobs]

Then you need to use the old way.
Sub test()
Dim filespec As Variant, i As Integer
'filespec = "c:\myfiles\test.xls"
On Error GoTo EndNow
filespec = Application.GetOpenFileName(FileFilter:="microsoft excel files (*.xls), *.xls", Title:="Get File", MultiSelect:=True)
'MsgBox GetFileName(filespec)
For i = 1 To UBound(filespec)
MsgBox filespec(i), , GetFileName(CStr(filespec(i)))
Next i
EndNow:
End Sub

' MsgBox GetFileName(filespec(0))
Function GetFileName(filespec As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
GetFileName = fso.GetFileName(filespec)
End Function

[Bob Phillips]

If it is pre-Excel 2002 I would use APIs



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

Private 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

'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function

[ukdane]

xld: Excel 2000

Kenneth: Your code only allows me to select a file name, not a folder.
I need the user to seelct a folder.

[ukdane]

xld: I've tried your pre-2002 code, and I'm getting the following error:

Compile Error:
Only comments may appear after each End Sub, End Function, or End Property.

(incidentally, whilst I'm writing this on my Excel 2000 as home, I'll need it to work at work, on Excel 2007 will that be a problem?)

[Kenneth Hobs]

I see.
The API method is the general method or try this one.
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=405
Sub Test()
MsgBox BrowseForFolder("C:\")
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.path
On Error GoTo 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function

[Bob Phillips]

xld: I've tried your pre-2002 code, and I'm getting the following error:

Compile Error:
Only comments may appear after each End Sub, End Function, or End Property.

(incidentally, whilst I'm writing this on my Excel 2000 as home, I'll need it to work at work, on Excel 2007 will that be a problem?)

Make sure the API declarations are before any procedures in your module, better still put it in anew module.

No problem for 2007, but I would add conditional compilation to invoke FileDialog in 2007, it just is so much better visually.

[ukdane]

Kenneth: Almost there, the code you provided works, but only from C:/ drive. When I use this at work, there could be a number of drivers that users will need to select from.
Maybe starting the list from "Mycomputer". How would I do that?

Cheers.

[ukdane]

Right, I've moved the API code into a new module, and it looks like it's working now.
Thanks a million.