Pull file names of a certain type or extension into Excel.

[Owompa]

I have cobbled together a macro that will pull all of the files from a folder into Excel. I would like to modify this macro so that a user can choose to only pull files names of a certain type into excel. (For example a user might choose to pull in only .pdf or .xlsm). I am at a loss as to what to do from here. Any help would be greatly appreciated. I apologize if my code is exceedingly juvenile, I am very new to this:

Dim iRow

Public Sub ListFiles()
    'Turns off Screen Updating
    Application.ScreenUpdating = False
    'Calls up the delete files macro
    Call DeleteData
    'Calls up ListMyFiles macro
    iRow = 11
    Call ListMyFiles(Range("FolderPath"), Range("IncludeSubfolders"))
    'Turns on Screen Updating
    Application.ScreenUpdating = True
End Sub

Private Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        iCol = 5
        Cells(iRow, iCol).Value = myFile.Name
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
    'This will add the fomula to the first cell needed to be pulled down.
    Range("FirstFileName").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(LEFT(RC[-2],FIND(""@"",SUBSTITUTE(RC[-2],""."",""@"",LEN(RC[-2])-LEN(SUBSTITUTE(RC[-2],""."",""""))))-1),"""")"
    'Fills down the formula in the above cell
    Range("Match.FileName").FillDown
End Sub

Private Sub DeleteData()
    'Deletes previous entries
    On Error Resume Next
    Range("Match.FileName,Match.FullFileName").Select
    Selection.ClearContents
End Sub

[abousetta]

Maybe try this:

Option Explicit

Dim iRow&

Public Sub ListFiles()
  ' Turns off Screen Updating
    Application.ScreenUpdating = False
  ' Deletes previous entries
    Range("Match.FileName,Match.FullFileName").ClearContents
  ' Calls up ListMyFiles macro
    iRow = 11
    ListMyFiles Range("FolderPath"), Range("IncludeSubfolders")
End Sub

Private Sub ListMyFiles(mySourcePath, IncludeSubfolders)
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
    For Each myFile In mySource.Files
        If myFile.Name Like "*" & ".xls" & "*" Then
            Cells(iRow, 5).Value = myFile.Name
            iRow = iRow + 1
        End If
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
    'This will add the fomula to the first cell needed to be pulled down.
    Range("FirstFileName").FormulaR1C1 = _
        "=IFERROR(LEFT(RC[-2],FIND(""@"",SUBSTITUTE(RC[-2],""."",""@"",LEN(RC[-2])-LEN(SUBSTITUTE(RC[-2],""."",""""))))-1),"""")"
    'Fills down the formula in the above cell
    Range("Match.FileName").FillDown
End Sub

abousetta