I want to browse for a folder where certain files are located. The code is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

.... but is there a way to be able to see the files in the browser as well as
the folders?

Thanks!

Below is a section of a routine where I wanted to let the user navigate to a
Word document from Excel (starting to look in the 'My Documents' folder).
If you want all types of files visible, do the .filter.clear but don't
follow up with .filter.add like I do in the example.

____________________________
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim myStoryDoc As String

Set objWd = CreateObject("Word.Application")

' Determine Path to the My Documents folder
Set objShell = CreateObject("Shell.Application")
Set objMyDocsFldr = objShell.Namespace(&H5&)
strMyDocsPath = objMyDocsFldr.Self.Path

' Create a file picker dialog opening to My Documents
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
..Filters.Clear
..Filters.Add "Word Documents", "*.doc"
..InitialFileName = strMyDocsPath
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
myStoryDoc = vrtSelectedItem
Next vrtSelectedItem
End If
End With

If Len(myStoryDoc) 8 Then
Set objDoc = objWd.Documents.Open(myStoryDoc)
___________________________

Steve Yandl



"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

http://www.developer.com/net/vb/article.php/1541831

RBS


"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

Noticed that the code in the mentioned url doesn't show the files but this
one
will I think:
http://www.oaltd.co.uk/mvp/MVPPage.asp
Look for code from Jim Rech.

RBS


"RB Smissaert" wrote in message
...
http://www.developer.com/net/vb/article.php/1541831

RBS


"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code
is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

Or use this API code, which gives you all the possible options:

Option Explicit
Public Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long)
As Long

Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As
Long

Private Declare Function GetOpenFileName Lib "comdlg32" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As
Long
Private Declare Function GetSaveFileName Lib "comdlg32" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As
Long

Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& 'see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS

Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY

Private Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type

Private OFN As OPENFILENAME

Function ChDirAPI(strFolder As String) As Long
'will return 1 on success and 0 on failure
'will work with a UNC path as well
'-----------------------------------------
ChDirAPI = SetCurrentDirectoryA(strFolder)
End Function

Function PickFileFolder(Optional bGetFile As Boolean = True, _
Optional bOpen As Boolean, _
Optional strStartFolder As String, _
Optional strFileFilters As String, _
Optional lFilterIndex As Long = 1, _
Optional strFileName As String, _
Optional strTitle As String, _
Optional bStayLastFolder As Boolean, _
Optional bMultiSelect As Boolean, _
Optional lHwnd As Long, _
Optional bSaveWarning As Boolean, _
Optional lPickedFilterIndex As Long = -1) As String

'------------------------------------------------------------
'adapted from Randy Birch:
'http://vbnet.mvps.org/index.html?code/comdlg/fileopendlg.htm
'------------------------------------------------------------
Dim strCurDir As String
Dim bChDir As Boolean

strCurDir = CurDir

If Len(strStartFolder) = 0 Then
strStartFolder = strCurDir
End If

'create a string of filters for the dialog
If Len(strFileFilters) = 0 Then
strFileFilters = "Text files (*.txt)" & vbNullChar &
"*.txt" & vbNullChar & _
"INI files (*.ini)" & vbNullChar &
"*.ini" & vbNullChar & _
"XLS files (*.xls)" & vbNullChar &
"*.xls" & vbNullChar & _
"Word files (*.doc)" & vbNullChar & "*.doc"
& vbNullChar & _
"Report code files (*.rcf)" & vbNullChar & "*.rcf" &
vbNullChar & _
"Access files (*.mdb)" & vbNullChar & "*.mdb"
& vbNullChar & _
"HTML files (*.html, *htm)" & vbNullChar &
"*.htm*" & vbNullChar & _
"Interbase files (*.gdb)" & vbNullChar & "*gdb" &
vbNullChar & _
"All files (*.*)" & vbNullChar & "*.*"
& vbNullChar & _
"Text or Filter files (*.txt, *.flt)" & vbNullChar &
"*.txt;*.flt" & vbNullChar & _
"Filter files (*.flt)" & vbNullChar &
"*.flt" & vbNullChar & _
"Text or SQL files (*.txt, *.sql)" & vbNullChar &
"*.txt;*.sql" & vbNullChar & _
"SQLite files (*.db3)" & vbNullChar &
"*.db3" & vbNullChar & vbNullChar

End If

If lHwnd = 0 Then
lHwnd = FindWindow("XLMAIN", Application.Caption)
End If

With OFN
'size of the OFN structure
.nStructSize = Len(OFN)
'window owning the dialog
.hWndOwner = lHwnd
'filters (patterns) for the dropdown combo
.sFilter = strFileFilters
'index to the initial filter
.nFilterIndex = lFilterIndex
'default filename, plus additional padding for the user's final
selection(s).
'Must be double-null terminated
If bGetFile Then
.sFile = strFileName & Space$(8192) & vbNullChar & vbNullChar
Else
.sFile = "Select a Folder" & Space$(8192) & vbNullChar & vbNullChar
End If
.nMaxFile = Len(.sFile) 'the size of the buffer
'default extension applied to file if it has no extention
.sDefFileExt = "txt" & vbNullChar & vbNullChar
'space for the file title if a single selection made
'double-null terminated, and its size
.sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
'starting folder, double-null terminated
.sInitialDir = strStartFolder & vbNullChar & vbNullChar
'the dialog title
.sDialogTitle = strTitle

'flags
'--------
If bGetFile Then
If bMultiSelect Then
If bStayLastFolder Then
'3701252
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_ALLOWMULTISELECT Or OFS_FILE_OPEN_FLAGS
Else
'3701260
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_ALLOWMULTISELECT Or OFS_FILE_OPEN_FLAGS Or _
OFN_NOCHANGEDIR
End If
Else
If bOpen Then
If bStayLastFolder Then
'3700740
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFS_FILE_OPEN_FLAGS
Else
'3700748
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFS_FILE_OPEN_FLAGS Or OFN_NOCHANGEDIR
End If
Else
If bStayLastFolder Then
If bSaveWarning Then
'2643982
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_NOCHANGEDIR Or OFS_FILE_SAVE_FLAGS
Else
'22540
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_NOCHANGEDIR
End If
Else
If bSaveWarning Then
'2643974
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFS_FILE_SAVE_FLAGS
Else
'22532
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE
End If
End If
End If
End If
Else
'16384
.flags = OFN_SHAREAWARE
End If
End With

Application.EnableCancelKey = xlDisabled

If bGetFile Then
If bOpen Then
If GetOpenFileName(OFN) Then
If bMultiSelect Then
PickFileFolder = BuildCSVMultiString(OFN.sFile)
Else
PickFileFolder = TrimNull(OFN.sFile)
End If
bChDir = True
Else
PickFileFolder = ""
End If
Else
If GetSaveFileName(OFN) Then
PickFileFolder = TrimNull(OFN.sFile)
bChDir = True
Else
PickFileFolder = ""
End If
End If
Else
If GetSaveFileName(OFN) Then
PickFileFolder = TrimNull(CurDir)
bChDir = True
Else
PickFileFolder = ""
End If
End If

Application.EnableCancelKey = xlInterrupt

'so the calling procedure knows what filter was picked
'-----------------------------------------------------
If lPickedFilterIndex -1 Then
lPickedFilterIndex = OFN.nFilterIndex
End If

If bStayLastFolder = False Then
If bChDir Then
ChDirAPI TrimNull(strCurDir)
End If
End If

End Function

Function BuildCSVMultiString(strString As String) As String

'will take a string of files produced by a multiselect
'where the files are separated by vbNullChar and make into
'a comma-separated string of files
'Will also work if only one file selected
'----------------------------------------------------------
Dim strFolder As String
Dim i As Long
Dim arr

arr = Split(strString, Chr(0))

For i = 0 To UBound(arr)
If i = 0 Then
'if only only one file selected the folder won't be in
'first element and folder names won't have dots
'-----------------------------------------------------
If InStr(1, arr(0), ".", vbBinaryCompare) 0 Then
BuildCSVMultiString = arr(0)
Exit Function
Else
strFolder = arr(0)
End If
Else
If InStr(1, arr(i), ".", vbBinaryCompare) = 0 Then
'no dot, so not a file anymore
'-----------------------------
Exit Function
End If
If i = 1 Then
BuildCSVMultiString = strFolder & "\" & arr(1)
Else
BuildCSVMultiString = BuildCSVMultiString & "," & _
strFolder & "\" & arr(i)
End If
End If
Next

End Function

Function TrimNull(strString As String) As String
TrimNull = Left$(strString, lstrlen(StrPtr(strString)))
End Function

Sub FileOpen()

Dim lPickedFilterIndex As Long

MsgBox "|" & PickFileFolder(, True, , , 1, , , , True, , ,
lPickedFilterIndex) & "|", , _
"result of the function"

MsgBox lPickedFilterIndex

End Sub

Sub SpecifyFolder()

MsgBox "|" & PickFileFolder(False, True, , , 1, , , , True) & "|", , _
"result of the function"

End Sub


RBS



"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

Thanks, but this is a file picker. I cannot use it to select a folder.

"Steve Yandl" wrote:

Below is a section of a routine where I wanted to let the user navigate to a
Word document from Excel (starting to look in the 'My Documents' folder).
If you want all types of files visible, do the .filter.clear but don't
follow up with .filter.add like I do in the example.

____________________________
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Dim myStoryDoc As String

Set objWd = CreateObject("Word.Application")

' Determine Path to the My Documents folder
Set objShell = CreateObject("Shell.Application")
Set objMyDocsFldr = objShell.Namespace(&H5&)
strMyDocsPath = objMyDocsFldr.Self.Path

' Create a file picker dialog opening to My Documents
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
..Filters.Clear
..Filters.Add "Word Documents", "*.doc"
..InitialFileName = strMyDocsPath
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
myStoryDoc = vrtSelectedItem
Next vrtSelectedItem
End If
End With

If Len(myStoryDoc) 8 Then
Set objDoc = objWd.Documents.Open(myStoryDoc)
___________________________

Steve Yandl



"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

Thanks, but this is much more complex than what I was looking for.

I'm having a hard time believing that there is not a simple way (filter or
other option for FileDialogFolderPicker) that allows one to see files while
browsing for a folder...

"RB Smissaert" wrote:

Noticed that the code in the mentioned url doesn't show the files but this
one
will I think:
http://www.oaltd.co.uk/mvp/MVPPage.asp
Look for code from Jim Rech.

RBS


"RB Smissaert" wrote in message
...
http://www.developer.com/net/vb/article.php/1541831

RBS


"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The code
is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as well
as
the folders?

Thanks!

You don't have to understand it, just use the function and put the arguments
in and you get exactly what you want. See the example Subs.

RBS


"tenlbham" wrote in message
...
Thanks, but this is much more complex than what I was looking for.

I'm having a hard time believing that there is not a simple way (filter or
other option for FileDialogFolderPicker) that allows one to see files
while
browsing for a folder...

"RB Smissaert" wrote:

Noticed that the code in the mentioned url doesn't show the files but
this
one
will I think:
http://www.oaltd.co.uk/mvp/MVPPage.asp
Look for code from Jim Rech.

RBS


"RB Smissaert" wrote in message
...
http://www.developer.com/net/vb/article.php/1541831

RBS


"tenlbham" wrote in message
...
I want to browse for a folder where certain files are located. The
code
is
just the basic:

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = True
If .Show = False Then Exit Sub
MyFolder = .SelectedItems(1)
End With

... but is there a way to be able to see the files in the browser as
well
as
the folders?

Thanks!

Dim objShell
Dim objFldr

Set objShell = CreateObject("Shell.Application")
Set objMyDocs = objShell.Namespace(&H5)
pathMyDocs = objMyDocs.Self.Path

On Error Resume Next
Set objFldr = objShell.BrowseForFolder(0, "pick me", &H4001, pathMyDocs)

If Not (objFldr Is Nothing) Then
MsgBox objFldr.Items.Item.Path
End If

Set objFldr = Nothing
Set objShell = Nothing




"tenlbham" wrote in message
...
Thanks, but this is a file picker. I cannot use it to select a folder.

Excellent, that's almost it!!! Thanks.

Question: this current browser object doesn't appear to give me the option
to go up to parent folders, is there a way to change that?

This is a different way of coding for me so I don't recognize how to change
the various options. Although I did figure out that the "&H5" was a
reference to My Documents (as changing it to H0-H9 set the directory to
various locations), and "&H4001" is perhaps some sort of filter. I was able
to get the browser to display NO files when I changed it to "&H1001"


"Steve Yandl" wrote:

Dim objShell
Dim objFldr

Set objShell = CreateObject("Shell.Application")
Set objMyDocs = objShell.Namespace(&H5)
pathMyDocs = objMyDocs.Self.Path

On Error Resume Next
Set objFldr = objShell.BrowseForFolder(0, "pick me", &H4001, pathMyDocs)

If Not (objFldr Is Nothing) Then
MsgBox objFldr.Items.Item.Path
End If

Set objFldr = Nothing
Set objShell = Nothing




"tenlbham" wrote in message
...
Thanks, but this is a file picker. I cannot use it to select a folder.

If I'm doing this with a vbScript file, I typically use the
"Scripting.FileSystemObject" to retrieve an appropriate parent folder or
drive, depending on where I want to start. The "Shell.Application" object
does offer a number of options other than the MyDocuments folder if you want
to stick to what I've got.
Here is a link to info on getting the path to various special folders:
http://www.microsoft.com/technet/scr....mspx?mfr=true

For some good information on using BrowseForFolder (written for script
writers but easy to use in a VBA routine, check out:
http://wsh2.freeweb.hu/ch12f.html


Steve Yandl



"tenlbham" wrote in message
...
Excellent, that's almost it!!! Thanks.

Question: this current browser object doesn't appear to give me the
option
to go up to parent folders, is there a way to change that?

This is a different way of coding for me so I don't recognize how to
change
the various options. Although I did figure out that the "&H5" was a
reference to My Documents (as changing it to H0-H9 set the directory to
various locations), and "&H4001" is perhaps some sort of filter. I was
able
to get the browser to display NO files when I changed it to "&H1001"


"Steve Yandl" wrote:

Dim objShell
Dim objFldr

Set objShell = CreateObject("Shell.Application")
Set objMyDocs = objShell.Namespace(&H5)
pathMyDocs = objMyDocs.Self.Path

On Error Resume Next
Set objFldr = objShell.BrowseForFolder(0, "pick me", &H4001, pathMyDocs)

If Not (objFldr Is Nothing) Then
MsgBox objFldr.Items.Item.Path
End If

Set objFldr = Nothing
Set objShell = Nothing




"tenlbham" wrote in message
...
Thanks, but this is a file picker. I cannot use it to select a folder.