GetOpenFilename With MultiSelect Intermittently Returns String

G

Guest

I am finding that GetOpenFilename does not work consistently with MultiSelect
set to True. The documentation on GetOpenFilename says that when MultiSelect
is set to True, it will always return an array unless the cancel button is
clicked, in which case it returns False. Nevertheless, half the time that
multiple files are selected it returns a Variant/String containing only the
first of the filenames that was selected.

Dim oSelection, oFileName As Variant
oSelection = Application.GetOpenFilename(MultiSelect:=True)
If Not IsArray(oSelection) Then Exit Sub
For Each oFileName In oSelection
MsgBox oFileName
Next

If I step through the code watching the Locals window I can see that after
the selection is made, GetOpenFilename intermittently returns oSelection as
Variant/Variant( ), in which case the code works correctly. Sometimes,
however, it returns oSelection as Variant/String, in which case the code
fails at "For Each oFileName In oSelection" and the code returns error "Type
mismatch."

I am not able to replicate this problem and of the few mentions I found of
this error on the internet, nobody seems to have found a solution or source
of the error.

Any help would be greatly appreciated. Thank you.
 
N

NickHK

Can't say I ever have that using:
If oSelection <> False Then

But with your code, if the return is a string then the code would exit on:
If Not IsArray(oSelection) Then Exit Sub
so how can your code ever error on the For Each line ?

NickHK
 
G

Guest

You're right. It does exit on "If not IsArray(oSelection) Then Exit Sub." I
forgot that I had changed to that method in an attempt to solve the problem,
but it didn't work. The problem is that the GetOpenFilename with MultiSelect
set to True is sometimes producing an array with all the selected files in,
and sometimes producing a string with only the first value in.

I have used "If oSelection <> False Then Exit Sub" as well. Then, of course,
the code gives error "Type mismatch" on "For Each oFileName In oSelection."

I have seen one reference to this problem that suggested it only happened if
the workbook in which the code was saved had multiple modules in. I have
moved all of my procedures to a single module and so far the error hasn't
occurred again.

Why would GetOpenFilename with MultiSelect = True fail in a workbook with
more than one module?
 
P

Peter T

Why would GetOpenFilename with MultiSelect = True fail in a workbook with
more than one module?

If that's the reason it would be a bug. You've probably seen this thread and
Greg Wilson's diagnosis
http://tinyurl.com/qbr2n

Did you try this (treeview post 13)

4. If you call it through Tools>Macro>Macros then it succeeds under all
conditions.

His observation about formulas being suspect was interesting. FWIW InputBox
Type:=8 also fails if an IsFormula CF exists on the active sheet (which is
one reason I don't use it).

Regards,
Peter T
 
N

NickHK

Certainly seems like a bug, if its causes are as describe.
In that case, why not implement a class wrapper to API version. That should
shield you from an Excel influences. e.g.
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA"
(pOpenfilename As OPENFILENAME) As Long

NickHK
 
G

Guest

For the record, following the post mentioned by Peter, I did confirm a bug
with GetOpenFilename and MultiSelect when conditional formats are applied
within the visble range of the worksheet and when the cf formulas contain
worksheet functions. It is not necessary for the macro to be fired from the
VBE (with VBE Main Window active) although the problem was found to be
sporadic only (and thus difficult to test for) when fired with the worksheet
displayed. It may also be a requirement that Data Validation be applied
within the visible range at the same time and may be system dependant (I have
xl2000 and Windows 2000 Professional SP3).

Greg
 
R

RB Smissaert

Try this API code.
With multiselects it will return the files as a comma separated string.
I think it works fine in all situations.


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) 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" & vbNullChar & "*.txt" & vbNullChar & _
"INI files" & vbNullChar & "*.ini" & vbNullChar & _
"XLS files" & vbNullChar & "*.xls" & vbNullChar & _
"Word files" & vbNullChar & "*.doc" & vbNullChar & _
"Report code files" & vbNullChar & "*.rcf" &
vbNullChar & _
"Access files" & vbNullChar & "*.mdb" & vbNullChar &
_
"HTML files" & vbNullChar & "*.html" & vbNullChar & _
"Interbase GDB files" & vbNullChar & "*gdb" &
vbNullChar & _
"All Files" & vbNullChar & "*.*" & 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$(1024) & vbNullChar & vbNullChar
Else
.sFile = "Select a Folder" & Space$(1024) & 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
'23044
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_ALLOWMULTISELECT Or OFS_FILE_OPEN_FLAGS
Else
'23052
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_ALLOWMULTISELECT Or OFN_NOCHANGEDIR Or _
OFS_FILE_OPEN_FLAGS
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
'22540
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFS_FILE_SAVE_FLAGS
Else
'2643982
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or _
OFN_PATHMUSTEXIST Or OFN_SHAREAWARE Or _
OFN_NOCHANGEDIR 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

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

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 tester()

MsgBox "|" & PickFileFolder(, True, , , 1, , , , True) & "|"

End Sub


RBS
 
R

RB Smissaert

Tidied this code a bit up:


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) 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 & 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$(8096) & vbNullChar & vbNullChar
Else
.sFile = "Select a Folder" & Space$(8096) & 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

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

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 tester()

MsgBox "|" & PickFileFolder(, True, , , 1, , , , True) & "|"

End Sub


It can't handle an un-limited number of files with a multi-select.
Haven't investigated, but I take it that is because of the buffer at:

.sFile = strFileName & Space$(8096) & vbNullChar & vbNullChar


RBS
 
G

Guest

Greg:

Sure enough, I came back to work on Monday and I am getting the error again.
So you are probably right.

Fortunately, I think I may have found an even better alternative.

In all my searching about the GetOpenFilename method nobody ever suggested
using the FileDialog property. The FileDialog property appears to work in
exactly the same manner as GetOpenFilename, but has even more flexibility.

Dim oFileDialog As FileDialog
Dim oSelectedItem As Variant
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
oFileDialog.AllowMultiSelect = True
If oFileDialog.Show = -1 Then
For Each oSelectedItem In oFileDialog.SelectedItems
MsgBox "Selected item's path: " & oSelectedItem
Next
End If
End With
Set oFileDialog = Nothing

I can only hope that the FileDialog property does not experience the same
problem as GetOpenFilename.

Thanks for your help.
 
P

Peter T

Sure enough, I came back to work on Monday and I am getting the error
again.
So you are probably right.

I also think Greg is right, an Isformula CF that includes a worksheet
function the culprit, same with app.Inputbox type 8.
The FileDialog property appears to work in
exactly the same manner as GetOpenFilename,

Good idea but bear in mind it needs XL2002 or later.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top