I'm trying to modify Jim Rech's code for Browse for Folder to give me a
spacific display. In one of his functions (code below), he sets the Desktop
as the root directory (5th line). My modification would be that a specific
directory (c:\MyDirectory\MySpecificDirrectory\). I know that we can set
the code to open in that directory, but you have all the upper folders that
makes the "folder tree" really bothersome to display since my folder is on
a network ... deep deep in my network (about 12 sub-folders deep)!! LOL

If you go in Internet Explorer, click on Favorites/Organize favorites and
click on move, you'll the same box that shows the folder without the higher
folders...

Thank you

Michel

'****This is taken from Jim Rech's Browse for Folder********
Function GetDirectory(InitDir As String, Flags As Long, CntrDlg As Boolean,
Msg) As String
Dim bInfo As BROWSEINFO
Dim pidl As Long, lpInitDir As Long

CntrDialog = CntrDlg ''Copy dialog centering setting to module level
variable so callback function can see it
With bInfo
.pidlRoot = 0 'Root folder = Desktop
.lpszTitle = Msg
.ulFlags = Flags

lpInitDir = LocalAlloc(LPTR, Len(InitDir) + 1)
CopyMemory ByVal lpInitDir, ByVal InitDir, Len(InitDir) + 1
.lParam = lpInitDir

If Val(Application.Version) 8 Then 'Establish the callback
function
.lpfn = BrowseCallBackFuncAddress
Else
.lpfn = AddrOf("BrowseCallBackFunc")
End If
End With
'Display the dialog
pidl = SHBrowseForFolder(bInfo)
'Get path string from pidl
GetDirectory = GetPathFromID(pidl)
CoTaskMemFree pidl
LocalFree lpInitDir
End Function

I've never been successful setting the root to anything other than a drive's
root. The follow streamlined code (no callback) sets the browse root to C:
but trying to set it lower results in a browse dialog that doesn't open.

Another problem with this solution, even if it did work, is that it uses an
undocumented Windows API call. No telling how reliable it is or if it will
be supported in the future.

--
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
''UNDOCUMENTED!!!!
Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal
szPath As String) As Long

Sub Demo()
Dim RetStr As String
RetStr = GetDirectory("Choose path", "C:\") ''but C:\ABC doesn't work
If RetStr < "" Then MsgBox RetStr
End Sub

Function GetDirectory(Msg As String, TreeRoot As String) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim ItemIdentifierListAddress As Long
Dim PathUnicode As String
PathUnicode = StrConv(TreeRoot, vbUnicode)
bInfo.pidlRoot = SHSimpleIDListFromPath(PathUnicode)
If Not IsMissing(Msg) Then bInfo.lpszTitle = Msg
ItemIdentifierListAddress = SHBrowseForFolder(bInfo)
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

MD,

You can experiment with the following and see if it does what you want.
It works for me...

'================================================= ============
' Jim Cone - San Francisco, CA - August 12, 2004
' Using code from "Colo"(colo @ consultant.interq.or.jp)
' Provides a list box to select the directory for the file search.
' Second argument will display the text string in the title area of the list box - make it short.
' Third argument specifies the type of display - see Hex values below.
' Fourth argument specifies the start folder. It is optional: "c:\" would bring up the C directory.

' Following constants from Chip Pearson web site:
' BIF_RETURNONLYFSDIRS As Long = &H1,
' BIF_DONTGOBELOWDOMAIN As Long = &H2
' BIF_RETURNFSANCESTORS As Long = &H8,
' BIF_BROWSEFORCOMPUTER As Long = &H1000
' BIF_BROWSEFORPRINTER As Long = &H2000,
' BIF_BROWSEINCLUDEFILES As Long = &H4000

'The following will display the list box with the "C:\Program Files" folder at the top and includes
'the files in the folders (&H4000). Use &H1 to display folders only.
'================================================= ==============
Function GetDirectory(ByRef strMessage As String) As String
On Error GoTo BadDirections
Dim objFF As Object
Set objFF = CreateObject("Shell.Application").BrowseForFolder( 0, strMessage, &H4000, "C:\Program Files")
If Not objFF Is Nothing Then
GetDirectory = objFF.items.Item.Path
Else
GetDirectory = vbNullString
End If
Set objFF = Nothing
Exit Function

BadDirections:
Set objFF = Nothing
GetDirectory = "Err"
End Function
'================================================= ==============

Jim Cone
San Francisco, CA


"MD" wrote in message ...
I'm trying to modify Jim Rech's code for Browse for Folder to give me a
spacific display. In one of his functions (code below), he sets the Desktop
as the root directory (5th line). My modification would be that a specific
directory (c:\MyDirectory\MySpecificDirrectory\). I know that we can set
the code to open in that directory, but you have all the upper folders that
makes the "folder tree" really bothersome to display since my folder is on
a network ... deep deep in my network (about 12 sub-folders deep)!! LOL

If you go in Internet Explorer, click on Favorites/Organize favorites and
click on move, you'll the same box that shows the folder without the higher
folders...

Thank you

Michel
-snip-

Hey Jim-

This is good for setting the displayed root, but it doesn't let you
pre-select a branch within the tree because it does not support callbacks.
Half a loaf either way, take the half you want.

--
Jim Rech
Excel MVP

Desperation must be the mother of invention!
(This works for XL2000. I understand that the file picker dialog works
for XP and later.)

I tried "Application.GetSaveAsFileName", and found that I can use it to
return a file pathname combination without actually selecting a file.

Setting the initialfilename parameter(not available in
GetOpenFilename), in the call does the trick. When the dialog opens,
select a directory. Select "Save" and the dialog will drill down. To
select the directory that is displayed in the dialog path dropdown,
simply select a blank area in the body of the dialog. The dialog then
returns a string equal to the displayed path plus the name of the
initialfilename parameter! - the path can then be parsed out.

Dim DestPath
InitFileName = "Do Not Enter a Name Here"
uTitle2 = "Select SUNCOR Destination Directory for PDF Files"
DestPath =
Application.GetSaveAsFilename(initialfilename:=Ini tFileName,
Title:=uTitle2)

(This technique also allows all the functionality of the standard MS
dialog, favorites, create directory, etc.)

A little finicky, but simple enough.

Alex J