Excel

Search directory and sub folders for Excel files

Ease of Use

Easy

Version tested with

Excel 2003 

Submitted by:

austenr

Description:

This routine searches a directory and sub folders for a selected file type. They are displayed in a new worksheet. 

Discussion:

If you have ever had to look through a large directory for files, this routine searches the directory and subfolders and displays them in a new worksheet. The files can be opened by clicking on the listed hyperlink. 

Code:

instructions for use

			

Option Explicit Sub SrchForFiles() ' Searches the selected folders and sub folders for files with the specified 'extension. .xls, .doc, .ppt, etc. 'A new worksheet is produced called "File Search Results". You can click on the link and go directly 'to the file you need. Dim i As Long, z As Long, Rw As Long Dim ws As Worksheet Dim y As Variant Dim fLdr As String, Fil As String, FPath As String y = Application.InputBox("Please Enter File Extension", "Info Request") If y = False And Not TypeName(y) = "String" Then Exit Sub Application.ScreenUpdating = False '********************************************************************** 'fLdr = BrowseForFolderShell With Application.FileDialog(msoFileDialogFolderPicker) .Show fLdr = .SelectedItems(1) End With '********************************************************************** With Application.FileSearch .NewSearch .LookIn = fLdr .SearchSubFolders = True .Filename = y Set ws = ThisWorkbook.Worksheets.Add(Sheets(1)) On Error Goto 1 2: ws.Name = "FileSearch Results" On Error Goto 0 If .Execute() > 0 Then For i = 1 To .FoundFiles.Count Fil = .FoundFiles(i) 'Get file path from file name FPath = Left(Fil, Len(Fil) - Len(Split(Fil, "\")(UBound(Split(Fil, "\")))) - 1) If Left$(Fil, 1) = Left$(fLdr, 1) Then If CBool(Len(Dir(Fil))) Then z = z + 1 ws.Cells(z + 1, 1).Resize(, 4) = _ Array(Dir(Fil), _ FileLen(Fil) / 1000, _ FileDateTime(Fil), _ FPath) ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1), _ Address:=.FoundFiles(i) End If End If Next i End If End With ActiveWindow.DisplayHeadings = False With ws Rw = .Cells.Rows.Count With .[A1:D1] .Value = [{"Full Name","Kilobytes","Last Modified", "Path"}] .Font.Underline = xlUnderlineStyleSingle .EntireColumn.AutoFit .HorizontalAlignment = xlCenter End With .[E1:IV1 ].EntireColumn.Hidden = True On Error Resume Next Range(Cells(Rw, "A").End(3)(2), Cells(Rw, "A")).EntireRow.Hidden = True Range(.[A2 ], Cells(Rw, "C")).Sort [A2 ], xlAscending, Header:=xlNo End With Application.ScreenUpdating = True Exit Sub 1: Application.DisplayAlerts = False Worksheets("FileSearch Results").Delete Application.DisplayAlerts = True Goto 2 End Sub

How to use:

  1. Open Excel
  2. Press Alt + F11 to display the VBE editor
  3. Go to Insert>Module
  4. Copy and paste the code above into the module.
  5. Save your changes and close the VB editor
  6. Press Alt + F8 and run SrchForFiles
  7. Enter the file extension you wish to list
  8. Browse to the folder you wish to check
 

Test the code:

  1. Open the sample file
  2. Click on the Search for File button
  3. Enter the file extension you wish to list
  4. Browse to the folder you wish to check and click OK
  5. You will be taken to the results page.
 

Sample File:

Search for files.zip 12.72KB 

Approved by mdmackillop


This entry has been viewed 640 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express