Thursday, November 25, 2004

VBA Macro in Excel for Finding Files in Folders

I use this base piece of code for finding files in the same subdirectory (or folder) that the file this code resides in is. I also use a modified version of it for known subdirectories.
The list of files gathered is processed in less than a second and can be pasted into the file or left in memory as an array and worked with. I use the latter process to open the files and work with them.

Paste the following code into a module in VBA Project Editor for Excel ensuring the that the top command, Option Base 1 is at the top of the module. The Dim statements can be made Public if desired.

Option Base 1
Sub find_files()
'Macro written by www.jethromanagement.biz September 2001
Dim thisfile, mydir, fname
Dim a, b
Dim flist()
Application.ScreenUpdating = False
'select subdir
'get filename and path
ThisWorkbook.Activate
fullfilename = ActiveWorkbook.FullName
'gets just the file name of this file
With ActiveWorkbook
thisfile = .Name
End With
'removes the filename to get the current drive and directory structure
mydir = Left(fullfilename, Len(fullfilename) - Len(thisfile))
'sets current drive to the drive in the path of the macro file
On Error GoTo nofiles
ChDir mydir
'find number of files
fname = mydir & "\*.xls"
a = 1
myname = Dir(fname) ' need to point it to the file mask
Do While myname <> "" ' Start the loop.
myname = Dir ' Get next filename
a = a + 1
Loop
'get file name data
ReDim flist(a - 1, 1)
b = 1
myname = Dir(fname) ' need to point it to the file mask
Do While myname <> "" ' Start the loop.
'extract file names during loop
Let flist(b, 1) = myname
myname = Dir ' Get next filename
b = b + 1
Loop
'enter file names into activecell - change to whatever range name you need
ActiveCell.Activate
Range(ActiveCell, ActiveCell.Offset(a - 2, 0)).Select
Selection = flist() 'fills selection with file names
Exit Sub
'error handler for no files
nofiles:
MsgBox "There were no files found."
nofiles = True
Application.ScreenUpdating = True
End Sub


Posted by: Jethro | 9:54 PM |