Re: Open File Dialog Filter

From: Nigel (nigel-sw_at_suxnospampanet.com)
Date: 03/23/05 

Date: Wed, 23 Mar 2005 18:24:48 -0000

Hi Bob

Double checked class module name, it is OK. I re-pasted the Class Module
code into the module and it works OK now.

It's curious, the first time I pasted the code into a un-named class (the
default class1), I then renamed it appropriately. If I re-name the class
module first and then paste it works! (more likely finger trouble on my
part!).

Anyway its just what I need, so thank you very much. 

-- 
Cheers
Nigel
"Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
news:%23HjZFh8LFHA.1948@TK2MSFTNGP14.phx.gbl...
> Instancing Private is fine.
>
> Double-check the class name, as that is the only thing I can think of that
> will cause the problem.
>
> -- 
>
> HTH
>
> RP
> (remove nothere from the email address if mailing direct)
>
>
> "Nigel" <nigel-sw@suxnospampanet.com> wrote in message
> news:%23o2CfX8LFHA.1180@TK2MSFTNGP14.phx.gbl...
> > Hi Bob,
> > Wow!  I have tried it but I have a problem.
> > I created the class module and pasted your code, named it
> > clsGetOpenFileName, I run the call from within a module sub routine but
> get
> > the message "Complie Error :  Internal Error"  nd the code halts at the
> > line.....
> >
> > Dim cFileOpen As clsGetOpenFileName
> >
> > which suggest to me that the class is not being recognised, the
instancing
> > is set to Private - is this correct?, or do I need to do something else?
> >
> > Sorry to be a pain but I'm new to class modules.
> >
> > -- 
> > Cheers
> > Nigel
> >
> >
> >
> > "Bob Phillips" <bob.phillips@notheretiscali.co.uk> wrote in message
> > news:uhDUAJ8LFHA.1144@TK2MSFTNGP09.phx.gbl...
> > > The you need the API.
> > >
> > >  use a version encapsulated in a class module, attached below. To use
> it,
> > > add this code to a class module, call it clsGetOpenFileName, and
invoke
> it
> > > is the following way
> > >
> > > Dim cFileOpen As clsGetOpenFileName
> > >
> > >
> > >     Set cFileOpen = New clsGetOpenFileName
> > >
> > >
> > >     With cFileOpen
> > >         .FileName = "Ex*.xls"
> > >         .FileType = "Excel Files"
> > >         .DialogTitle = "Class GetOpenFileName Demo"
> > >         .MultiFile = "N"
> > >         .SelectFile
> > >
> > >
> > >         If .SelectedFiles.Count > 0 Then
> > >             MsgBox (.SelectedFiles(1))
> > >         End If
> > >     End With
> > >
> > >
> > >     Set cFileOpen = Nothing
> > >
> > >
> > > Other code is after my signature
> > >
> > >
> > >
> > >
> > > -- 
> > >
> > > HTH
> > >
> > > RP
> > > (remove nothere from the email address if mailing direct)
> > >
> > >
> > >
> > > Option Explicit
> > >
> > >
> > >
> >
>
'-----------------------------­------------------------------­--------------
> > > --
> > > ' Win32 API Declarations
> > >
> >
>
'-----------------------------­------------------------------­--------------
> > > --
> > > Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
> > >     Alias "GetOpenFileNameA" _
> > >    (pOpenfilename As OPENFILENAME) As Long
> > >
> > >
> > > Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
> > >     Alias "GetSaveFileNameA" _
> > >    (pOpenfilename As OPENFILENAME) As Long
> > >
> > >
> > > Private Declare Function GetShortPathName Lib "kernel32" _
> > >     Alias "GetShortPathNameA" _
> > >    (ByVal lpszLongPath As String, _
> > >     ByVal lpszShortPath As String, _
> > >     ByVal cchBuffer As Long) As Long
> > >
> > >
> > > 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 Variables
> > >
> >
>
'-----------------------------­------------------------------­--------------
> > > --
> > > Private OFN As OPENFILENAME
> > >
> > >
> > > Private sFileType As String         'Type of file narrative
> > > Private sFileName As String         'Filename string to restrict list
> > > Private sReadOnly As String         'Y/N flag
> > > Private sMultiFile As String        'Allow selection of multiple files
> > > Private sTitle As String            'Title in file dialog box
> > >
> > >
> > >
> >
>
'-----------------------------­------------------------------­--------------
> > > --
> > > ' Private Constants
> > >
> >
>
'-----------------------------­------------------------------­--------------
> > > --
> > > 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
> > >
> > >
> > > 'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below are mine to save
long
> > > 'statements; they're not a standard Win32 type.
> > > Private Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
> > >                                    OFN_LONGNAMES Or _
> > >                                    OFN_CREATEPROMPT Or _
> > >                                    OFN_NODEREFERENCELINKS
> > >
> > >
> > > Private Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or _
> > >                                    OFN_LONGNAMES Or _
> > >                                    OFN_OVERWRITEPROMPT Or _
> > >                                    OFN_HIDEREADONLY
> > >
> > >
> > >     '-----------------------------­------------------------------­--
> > >     ' Class Properties
> > >     '-----------------------------­------------------------------­--
> > >     Public SelectedFiles As New Collection
> > >
> > >
> > >     Public Property Let FileType(FileType As String)
> > >         sFileType = FileType
> > >     End Property
> > >
> > >
> > >     Public Property Let FileName(FileName As String)
> > >         sFileName = FileName
> > >     End Property
> > >
> > >
> > >     Public Property Let MultiFile(MultiFile As String)
> > >         sMultiFile = UCase(MultiFile)
> > >     End Property
> > >
> > >
> > >     Public Property Let DialogTitle(Title As String)
> > >         sTitle = Title
> > >     End Property
> > >
> > >
> > >     Public Property Get ReadOnly()
> > >         ReadOnly = sReadOnly
> > >     End Property
> > >
> > >
> > >     '-----------------------------­------------------------------­--
> > >     ' Class Methods
> > >     '-----------------------------­------------------------------­--
> > >     Public Function SelectFile() As Long
> > >     '-----------------------------­------------------------------­--
> > >     Dim i
> > >     Dim sFilters As String
> > >     Dim sBuffer As String
> > >     Dim sLongname As String
> > >     Dim sShortname As String
> > >
> > >         If ValidInput Then
> > >                 'create a string of filters for the dialog
> > >             sFilters = sFileType & vbNullChar & vbNullChar
> > >
> > >             With OFN
> > >
> > >                 .nStructSize = Len(OFN)         'Size of the OFN
> structure
> > >                 .sFilter = sFilters             'Filters for the
> dropdown
> > >                 .nFilterIndex = 1               'Index to the initial
> > filter
> > >
> > >                 .sFile = sFileName & Space$(1024) & vbNullChar &
> > vbNullChar
> > >
> > >                 .nMaxFile = Len(.sFile)
> > >                 .sDefFileExt = sFileName & vbNullChar & vbNullChar
> > >                 .sFileTitle = vbNullChar & Space$(512) & _
> > >                               vbNullChar & vbNullChar
> > >                 .nMaxTitle = Len(OFN.sFileTitle)
> > >                 .sInitialDir = ThisWorkbook.Path & vbNullChar
> > >
> > >                 .sDialogTitle = sTitle
> > >
> > >                 .flags = OFS_FILE_OPEN_FLAGS Or _
> > >                          OFN_NOCHANGEDIR
> > >
> > >                 If sMultiFile = "Y" Then .flags = .flags Or _
> > >                         OFN_ALLOWMULTISELECT
> > >
> > >             End With
> > >
> > >             SelectFile = GetOpenFileName(OFN)
> > >             If SelectFile Then
> > >                         'Remove trailing pair of terminating nulls and
> > >                         '   trim returned file string
> > >                 sBuffer = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
> > >                         'If multiple-  select, first member is the
path,
> > >                         '   remaining members are the files under that
> > >                         '   path
> > >                 Do While Len(sBuffer) > 3
> > >                     SelectedFiles.Add StripDelimitedItem( _
> > >                             sBuffer, vbNullChar)
> > >                 Loop
> > >
> > >                 sReadOnly = Abs((OFN.flags And OFN_READONLY))
> > >
> > >             End If
> > >         End If
> > >
> > >     End Function
> > >
> > >
> > > Private Sub Class_Initialize()
> > >     sTitle = "GetOpenFileName"
> > > End Sub
> > >
> > >
> > > Private Sub Class_Terminate()
> > >     Set SelectedFiles = Nothing
> > > End Sub
> > >
> > >
> > > '-----------------------------­------------------------------­------
> > > Private Function ValidInput() As Boolean
> > > '-----------------------------­------------------------------­------
> > > Dim i As Integer
> > >
> > >     ValidInput = True
> > >
> > >     i = 1
> > >     If IsEmpty(sFileName) Then
> > >         sFileName = " - a file description must be supplied"
> > >         i = i + 1
> > >         ValidInput = False
> > >     End If
> > >
> > >     If IsEmpty(sFileType) Then
> > >         sFileType = " - a file extension must be supplied"
> > >         i = i + 1
> > >         ValidInput = False
> > >     End If
> > >
> > >     If sMultiFile <> "Y" And sMultiFile <> "N" Then
> > >         sMultiFile = "Multiple files must be Y or N"
> > >         i = i + 1
> > >         ValidInput = False
> > >     End If
> > >
> > > End Function
> > >
> > >
> > > '-----------------------------­------------------------------­------
> > > Private Function StripDelimitedItem(startStrg As String, _
> > >                                     delimiter As String) As String
> > > '-----------------------------­------------------------------­------
> > >
> > >   'take a string separated by nulls, split off 1 item,
> > >   '   and shorten the string so the next item
> > >   '   is ready for removal.
> > > Dim pos As Long
> > > Dim item As String
> > >
> > >     pos = InStr(1, startStrg, delimiter)
> > >
> > >
> > >     If pos Then
> > >         StripDelimitedItem = Mid$(startStrg, 1, pos)
> > >         startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
> > >     End If
> > >
> > > End Function
> > >
> > >
> > > '-----------------------------­------------------------------­------
> > > Private Function TrimNull(item As String) As String
> > > '-----------------------------­------------------------------­------
> > > Dim pos As Integer
> > >
> > >     pos = InStr(item, Chr$(0))
> > >     If pos Then
> > >         TrimNull = Left$(item, pos - 1)
> > >     Else
> > >         TrimNull = item
> > >     End If
> > >
> > > End Function
> > >
> > >
> > >
> > > "Nigel" <nigel-sw@suxnospampanet.com> wrote in message
> > > news:ufgbf67LFHA.3348@TK2MSFTNGP10.phx.gbl...
> > > > Hi All,
> > > >
> > > > I am using the following construct to select files......., which
works
> > > > great.
> > > >
> > > >   xFile = Application.GetOpenFilename("ARTS_Daily (*.xls), *.xls",
1,
> > > > "Choose File", "", False)
> > > >
> > > > I have a need to filter not just the file extension as in *.xls but
> also
> > > the
> > > > filename eg ... ARTS*.xls, to give all xls files beginning with
ARTS.
> > > > Something like.....
> > > >
> > > >    xFile = Application.GetOpenFilename("ARTS_Daily (ARTS*.xls),
> > > ARTS*.xls",
> > > > 1, "Choose File", "", False)
> > > >
> > > > However this does not work as expected, with the dialog defaulting
the
> > > > filter to All files *.*
> > > >
> > > > Any ideas anyone on how best to achieve this?
> > > >
> > > > -- 
> > > > Cheers
> > > > Nigel
> > > >
> > > >
> > > >
> > > >
> > >
> > >
> >
> >
>
>
Loading