Folder picker default - second attempt...

[pk]

Hello, I hope someone can help me please.

I am using the built-in folder picker:

Application.FileDialog(msoFileDialogFolderPicker)

And I would like to have it initially display all of our
network shares along with the local drives. On our
network, this is equivalent to clicking "Computer" which I
think is equivalent to "My Computer".

I know you can name an initial path using:

...InitialFileName = "{my path}"

But I can't seem to get it to default to "computer" or at
least to a listing of the network shares. Does anyone know
how to do this?

Your example code is mostly what I need. Thanks in advance
for your assistance...
..

 

[Jim Rech]

I didn't have any luck either trying to get the dialog to open at My
Computer. If no one comes up with an answer you might want to consider a
different approach. The following uses a built-in Windows function to
create an interface for picking a folder. The Windows' SHBrowseForFolder
function actually provides many more options than this example shows, but it
may be all you need. For a more complete example look at the
BrowseForFolder demo I uploaded to Stephen Bullen's site
(http://www.bmsltd.co.uk/MVP/Default.htm).

--
Jim Rech
Excel MVP

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

'Main Browse for directory function
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Gets path from pidl
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long

Sub Demo()
Dim RetStr As String
RetStr = GetDirectory("Choose path")
If RetStr <> "" Then MsgBox RetStr
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim ItemIdentifierListAddress As Long
Dim Success As Boolean

bInfo.pidlRoot = 0 'Root folder = Desktop

If Not IsMissing(Msg) Then bInfo.lpszTitle = Msg
'Display the dialog
ItemIdentifierListAddress = SHBrowseForFolder(bInfo)
'Get path string from ID
GetDirectory = GetPathFromID(ItemIdentifierListAddress)
End Function

'Converts a PIDL to a string
Function GetPathFromID(ID As Long) As String
Dim Result As Boolean, Path As String * 255
Result = SHGetPathFromIDList(ID, Path)
If Result Then
GetPathFromID = Left(Path, InStr(Path, Chr$(0)) - 1)
Else
GetPathFromID = ""
End If
End Function

 

[pk]

Jim, your work around does the trick, thanks! I'll also
have a look at the site you mentioned. Cheers.

 

[keepitcool]

pk,

As an easier alternative to Jim's API approach:

Set a reference to Microsoft Scripting Runtime
then have a look at (Scripting) .FileSystemObject

plenty to find with google!


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[John Redmayne]

Jim,

A bit of serendipity!

I was required to write exactly the same procedure, and
failing dismally. Logged onto the group and hey presto,
there is the answer.

Many many thanks.

John Redmayne