Need help adding code that lists out extension specific files. Thanks

[TMELANCON]

I have a spreadsheet that I open, selected a directory, and it gets files that are going to be put through a GIF creation process and a rename process. The problem is that there is currently no filtering applied in the code. I am a bit of a noob but can understand very very basic vba, just enough to tread water. Can someone simply modify my code that applies a filter to just select ".XLS" files and exclude (or clear) the rest from the list. Thanks in advance.

I have a button in 'A3' that gets the filenames from specified directory. 'A4' is the directory as selected by user. 'A5' starts the list. Any and all help would be eternally appreciated.

Private Sub Get_All_Click()
    Dim directory As String
    
    directory = BrowseDirectory("Select Directory to Get File Names.")
    Range("A4").Select
    ActiveCell.Value = directory
    Range("A5").Select
    'ActiveCell.Offset(0, 1).Value = "=IF(ISNA(MATCH(B4,A:A,0))," & _
        Chr(34) & "Yes " & Chr(34) & "," & Chr(34) & "No" & Chr(34) & ")"
    Dim file_name As String
    Dim strRowSource As String ' Build row source string here to get all files
    Dim i As Integer ' MyArray index for fill
    Dim j As Integer ' MyArray index for move to list box

    On Error Resume Next
    'list the names of all files in the specified directory

    file_name = dir$(directory & "\*.*", vbDirectory)
    i = 1
    Do While (Len(file_name) > 0) 'And (i < 101)
        ' See if we should skip this file.
        If Not ((file_name = ".") Or (file_name = "..")) Then
            ActiveCell.Value = file_name
            i = i + 1
            ActiveCell.Offset(1, 0).Select
            'ActiveCell.Offset(-1, 1).AutoFill Destination:=Range _
            '    (ActiveCell.Offset(-1, 1), ActiveCell.Offset(0, 1)), _
             '   Type:=xlFillDefault
            'ActiveCell.Offset(1, 0).Select
        End If
        ' Get the next file.
        file_name = dir$()
    Loop
    'If i > 1 Then

 '       ' note here is the code for QuickSort subroutine
 '       QuickSort MyArray, 1, i - 1
 '       'use sorted array to refill listbox
 '       cmbList.RowSource = "" 'clears the list
 '       For j = 1 To i
 '           strRowSource = strRowSource & MyArray(j) & ";"
 '       Next j
 '
 '           ' If there are too many files take the most recent
 '           'RowSource string length is 2048 characters
 '           cmbList.RowSource = Left(strRowSource, 2048
 '       Else
 '       cmbList.RowSource = MyArray(1)
 '   End If
    Range("A4").Select
End Sub

 

[JoeMo]

Untested, but at quick glance, looks like you may just need one line altered.

Change this line:

If Not ((file_name = ".") Or (file_name = "..")) Then

to this:

If Not ((file_name = ".") Or (file_name = "..")) and Ucase(file_name) Like "*.XLS" Then

 

[TMELANCON]

Worked like a charm Joe. Thank you so much for your time and valuable input. Blessings.

 

[JoeMo]

Worked like a charm Joe. Thank you so much for your time and valuable input. Blessings.

You are welcome - thanks for the reply.