+ Reply to Thread
Results 1 to 7 of 7

Open File Dialog Filter

  1. #1
    Nigel
    Guest

    Open File Dialog Filter

    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





  2. #2
    Bob Phillips
    Guest

    Re: Open File Dialog Filter

    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" <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >
    >
    >
    >




  3. #3
    Tom Ogilvy
    Guest

    Re: Open File Dialog Filter

    It isn't supported in GetOpenFileName

    if you will just be using xl2002 or later, you might look at the FileDialog.
    Here is an example that only shows b*.xls files

    Sub Main()

    'Declare a variable as a FileDialog object
    Dim fd As FileDialog

    'Create a FileDialog object '
    ' as a File Picker dialog box.
    Set fd = Application.FileDialog( _
    msoFileDialogFilePicker)

    'Declare a variable to contain the path
    'of each selected item.
    'Even though the path is a String,
    'the variable must be a Variant
    'because For Each...Next
    'routines only work with
    'Variants and Objects.
    Dim vrtSelectedItem As Variant

    'Use a With...End With block to reference
    'the FileDialog object.
    With fd

    'Set the initial path to the C:\ drive.
    .InitialFileName = "C:\Data1\b*.xls"

    'Use the Show method to display the
    'File Picker dialog box and return the
    ' user's action.
    'If the user presses the action button...
    If .Show = -1 Then

    'Step through each string '
    'in the FileDialogSelectedItems collection.
    For Each vrtSelectedItem _
    In .SelectedItems

    'vrtSelectedItem is a String
    'that contains the path of
    'each selected item.
    'You can use any file I/O functions
    'that you want to work with this path.
    'This example simply displays
    'the path in a message box.
    MsgBox "Selected item's path: " _
    & vrtSelectedItem

    Next vrtSelectedItem
    'If the user presses Cancel...
    Else
    End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing

    End Sub


    --
    Regards,
    Tom Ogilvy

    "Nigel" <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >
    >
    >
    >




  4. #4
    Nigel
    Guest

    Re: Open File Dialog Filter

    Thanks Tom, I will be using xl97 so cannot progress this solution. It is
    good to know anyway.

    --
    Cheers
    Nigel



    "Tom Ogilvy" <[email protected]> wrote in message
    news:[email protected]...
    > It isn't supported in GetOpenFileName
    >
    > if you will just be using xl2002 or later, you might look at the

    FileDialog.
    > Here is an example that only shows b*.xls files
    >
    > Sub Main()
    >
    > 'Declare a variable as a FileDialog object
    > Dim fd As FileDialog
    >
    > 'Create a FileDialog object '
    > ' as a File Picker dialog box.
    > Set fd = Application.FileDialog( _
    > msoFileDialogFilePicker)
    >
    > 'Declare a variable to contain the path
    > 'of each selected item.
    > 'Even though the path is a String,
    > 'the variable must be a Variant
    > 'because For Each...Next
    > 'routines only work with
    > 'Variants and Objects.
    > Dim vrtSelectedItem As Variant
    >
    > 'Use a With...End With block to reference
    > 'the FileDialog object.
    > With fd
    >
    > 'Set the initial path to the C:\ drive.
    > .InitialFileName = "C:\Data1\b*.xls"
    >
    > 'Use the Show method to display the
    > 'File Picker dialog box and return the
    > ' user's action.
    > 'If the user presses the action button...
    > If .Show = -1 Then
    >
    > 'Step through each string '
    > 'in the FileDialogSelectedItems collection.
    > For Each vrtSelectedItem _
    > In .SelectedItems
    >
    > 'vrtSelectedItem is a String
    > 'that contains the path of
    > 'each selected item.
    > 'You can use any file I/O functions
    > 'that you want to work with this path.
    > 'This example simply displays
    > 'the path in a message box.
    > MsgBox "Selected item's path: " _
    > & vrtSelectedItem
    >
    > Next vrtSelectedItem
    > 'If the user presses Cancel...
    > Else
    > End If
    > End With
    >
    > 'Set the object variable to Nothing.
    > Set fd = Nothing
    >
    > End Sub
    >
    >
    > --
    > Regards,
    > Tom Ogilvy
    >
    > "Nigel" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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
    > >
    > >
    > >
    > >

    >
    >




  5. #5
    Nigel
    Guest

    Re: Open File Dialog Filter

    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" <[email protected]> wrote in message
    news:[email protected]...
    > 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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
    > >
    > >
    > >
    > >

    >
    >




  6. #6
    Bob Phillips
    Guest

    Re: Open File Dialog Filter

    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" <[email protected]> wrote in message
    news:%[email protected]...
    > 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" <[email protected]> wrote in message
    > news:[email protected]...
    > > 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" <[email protected]> wrote in message
    > > news:[email protected]...
    > > > 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
    > > >
    > > >
    > > >
    > > >

    > >
    > >

    >
    >




  7. #7
    Nigel
    Guest

    Re: Open File Dialog Filter

    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" <[email protected]> wrote in message
    news:%[email protected]...
    > 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" <[email protected]> wrote in message
    > news:%[email protected]...
    > > 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" <[email protected]> wrote in message
    > > news:[email protected]...
    > > > 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" <[email protected]> wrote in message
    > > > news:[email protected]...
    > > > > 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
    > > > >
    > > > >
    > > > >
    > > > >
    > > >
    > > >

    > >
    > >

    >
    >




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1