Exclude Files from GetOpenFileName based on File Name

Hi

I've this code to present the user of a list of files to open

' File filters
    Filter = "Excel Files (*.xls*),*.xls*  "
    FilterIndex = 1
    ' Set DialogCaption
    Title = "Select a File to Open"
 
    ' Select Start Drive & Path
    ChDir "C:\ABC\CBA LOSE"  'You will need to change this to S:\ABC\CBA LOSE\
 
    With Application
        ' Set File Name to selected File
        fileName = .GetOpenFilename(Filter, FilterIndex, Title)
    End With
    ' Exit on Cancel
    If fileName = False Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    ' Open File
    Workbooks.Open fileName

and it presents with this screen screen capture.jpg

I'd like the screen to NOT include any files with "Apple" in the file name. So, the fifth item on the list (Apple MTS (Template).xls) would not be displayed. ( I've tried to filter on "<> InStr(File.Name,"Apple")" with no success.

Any way to accomplish this?

Hello John,

You can't do it using the Application.GetOpenFileName dialog. However, it may be possible with the API. I will have to look in library.

Thanks Leith...if you can point me in a direction, I'd appreciate it.

Hello John,

The API allows more flexibilty but nothing to control the listing files by name, only by extension. Looks like you will have to use a UserForm and create your own.

Thanks Leith...I had considered the UserForm approach...hoped to find a shortcut

Hi Leith

I found this code (sorry, forgot to attribute) that works in Excel 2000...haven't been able to convert to Excel 2007 (Application.FileSearch issue). Don't ask you to do it for me...can you give me a clue?

Private Sub UserForm_Initialize()
    Dim ArrayVals() As Variant
    Dim Num As Integer
    Me.Caption = "Double click on the file that you wish to open"
    With ListBox1
        .ColumnCount = 2
        .ColumnWidths = "0; 60"
    End With
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\ABC\CBA LOSE"
        .SearchSubFolders = True
        .Filename = "*.xls"
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending) > 0 Then
            Num = 0
            For i = 1 To .FoundFiles.Count
                If Not InStr(.FoundFiles.Item(i), "Apples") > 1 Then
                    ReDim Preserve ArrayVals(0 To 1, 0 To Num)
                    ArrayVals(0, Num) = .FoundFiles.Item(i)
                    ArrayVals(1, Num) = Dir(.FoundFiles.Item(i))
                    Num = Num + 1
                Else: Num = Num
                End If
                'Num = Num + 1
            Next i
            ListBox1.Column = ArrayVals
        Else
            MsgBox "No Files Found"
            Unload Me
        End If
    End With
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Workbooks.Open Filename:=ListBox1.Value
Unload Me
End Sub