Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "Lazzaroni" wrote in message ... 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. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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? "NickHK" wrote: 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 "Lazzaroni" wrote in message ... 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 ToolsMacroMacros 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 "Lazzaroni" wrote in message ... 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? "NickHK" wrote: 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 "Lazzaroni" wrote in message ... 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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
Peter:
Thanks for pointing out that thread to me. I had not seen it. I am using Excel 2003 SP2. I also have conditional formatting using formulas in the sheets calling the procedure. In my case the conditional formatting does not appear to be causing any problems. Rather, the problem appears to have been that the workbook in which the code is stored (PERSONAL.XLS) had more than one module in. Once I moved all procedures to one module and deleted all the others GetOpenFilename with Multiselect = True appears to be consistently returning an array. I only made the change today, so if I run into the error again I'll post another reply. I found the suggestion to use only one module at this address: http://www.dailydoseofexcel.com/arch...topenfilename/ September 12th, 2004 at 7:17 pm JohnT Says: "I have a GetOpenFilename with MultiSelect:=True which works perfectly if it is the only module in my Excel work book. But If I copy the exact same code (CRTL/A - CTRL/C) to an empty module (CTRL/V) in a file which has a heap of other code then it refuses to do the multislect but will only return a single file. Any bright ideas as to what may be going on in the depths of VBA?" |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "Lazzaroni" wrote in message ... Peter: Thanks for pointing out that thread to me. I had not seen it. I am using Excel 2003 SP2. I also have conditional formatting using formulas in the sheets calling the procedure. In my case the conditional formatting does not appear to be causing any problems. Rather, the problem appears to have been that the workbook in which the code is stored (PERSONAL.XLS) had more than one module in. Once I moved all procedures to one module and deleted all the others GetOpenFilename with Multiselect = True appears to be consistently returning an array. I only made the change today, so if I run into the error again I'll post another reply. I found the suggestion to use only one module at this address: http://www.dailydoseofexcel.com/arch...topenfilename/ September 12th, 2004 at 7:17 pm JohnT Says: "I have a GetOpenFilename with MultiSelect:=True which works perfectly if it is the only module in my Excel work book. But If I copy the exact same code (CRTL/A - CTRL/C) to an empty module (CTRL/V) in a file which has a heap of other code then it refuses to do the multislect but will only return a single file. Any bright ideas as to what may be going on in the depths of VBA?" |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "Lazzaroni" wrote: Peter: Thanks for pointing out that thread to me. I had not seen it. I am using Excel 2003 SP2. I also have conditional formatting using formulas in the sheets calling the procedure. In my case the conditional formatting does not appear to be causing any problems. Rather, the problem appears to have been that the workbook in which the code is stored (PERSONAL.XLS) had more than one module in. Once I moved all procedures to one module and deleted all the others GetOpenFilename with Multiselect = True appears to be consistently returning an array. I only made the change today, so if I run into the error again I'll post another reply. I found the suggestion to use only one module at this address: http://www.dailydoseofexcel.com/arch...topenfilename/ September 12th, 2004 at 7:17 pm JohnT Says: "I have a GetOpenFilename with MultiSelect:=True which works perfectly if it is the only module in my Excel work book. But If I copy the exact same code (CRTL/A - CTRL/C) to an empty module (CTRL/V) in a file which has a heap of other code then it refuses to do the multislect but will only return a single file. Any bright ideas as to what may be going on in the depths of VBA?" |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "Lazzaroni" wrote in message ... 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. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "RB Smissaert" wrote in message ... 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 "Lazzaroni" wrote in message ... 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. |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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. |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
GetOpenFilename With MultiSelect Intermittently Returns String
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 "Lazzaroni" wrote in message ... 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
GetOpenFilename MultiSelect failure | Excel Programming | |||
VBA prob-GetOpenFilename with multiselect=true returns string | Excel Programming | |||
GetOpenFilename returns a string rather than an array | Excel Programming | |||
GetOpenFilename returns a string rather than an array | Excel Programming | |||
Calling a C++ DLL which returns a String | Excel Programming |