I need code that will look at all the files in a subdirectory and loop
through just the ones that are older than the first of the current month,
operating on them one at a time. I used to do this with the FileSearch
command, but that's gone in Excel 2007. How could I do it now?

Thanks for your help.

You need to use a recursive DIR( ).
Check out Mr Excel's...
http://www.mrexcel.com/forum/showthr...=recursive+dir

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"Stratuser" wrote:

I need code that will look at all the files in a subdirectory and loop
through just the ones that are older than the first of the current month,
operating on them one at a time. I used to do this with the FileSearch
command, but that's gone in Excel 2007. How could I do it now?

Thanks for your help.

Is there a date property for a file found by DIR? How do I specify that I
want only files before a certain date?



"Gary Brown" wrote:

You need to use a recursive DIR( ).
Check out Mr Excel's...
http://www.mrexcel.com/forum/showthr...=recursive+dir

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"Stratuser" wrote:

I need code that will look at all the files in a subdirectory and loop
through just the ones that are older than the first of the current month,
operating on them one at a time. I used to do this with the FileSearch
command, but that's gone in Excel 2007. How could I do it now?

Thanks for your help.

Here's a short version of the details. I'll attached another thread with the
program I use to select a folder, choose whether or not to have the search
look into the subfolders, ask for a search pattern such as *.xls*, then spit
the resutls out to a new worksheet.
The program below put the information into the IMMEDIATE window using a
Debug.Print statement. The main program below is 'ListFilesToDebug' and
calls another procedure called 'recurseSubFolders'.
--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

'/=========================================/
' Sub Purpose: change from FileSearch to recursive DIR
' for 2007 comparability (Dir Recursive
' basic concept from MrExcel.com)
'/=========================================/
'
Public Sub ListFilesToDebug()
Dim blnSubFolders As Boolean
Dim k As Long, i As Long
Dim fso As Object
Dim strArr() As String
Dim strName As String
Dim strDirectory As String
Dim strFileNameFilter As String

On Error Resume Next

'- - - - - V A R I A B L E S - - - - - - - -
strDirectory = "C:\Temp\" 'look in this folder
blnSubFolders = True 'look in all sub folders if TRUE
strFileNameFilter = "*.XL*" 'filter on these files
'- - - - - - - - - - - - - - - - - - - - - -

'get 1st filename
strName = Dir(strDirectory & strFileNameFilter)

'put filenames into array
Do While strName < vbNullString
k = k + 1
ReDim Preserve strArr(k)
strArr(k) = strDirectory & strName
strName = Dir() 'get next file name
Loop

'get subfolder filenames if subfolder option selected
If blnSubFolders Then
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDirectory), _
strArr(), k, strFileNameFilter)
End If

'show the results in the IMMEDIATE window
For i = 1 To k
Debug.Print strArr(i) & " - " & FileDateTime(strArr(i))
Next i

exit_Sub: 'generic exit sub routine
On Error Resume Next
Exit Sub

err_Sub: 'generic error message routine
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: ListFilesToDebug - " & Now()
GoTo exit_Sub

End Sub

'/=========================================/
' Sub Purpose: recursive for filesearch 2007
'/=========================================/
'
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String

On Error GoTo err_Sub

For Each SubFolder In Folder.SubFolders
'get 1st filename in subfolder
strName = _
Dir(SubFolder.Path & Application.PathSeparator & searchTerm)
'put filenames and file info in subfolders into array
Do While strName < vbNullString
i = i + 1
ReDim Preserve strArr(i)
strArr(i) = _
SubFolder.Path & Application.PathSeparator & strName
strName = Dir()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next

exit_Sub:
On Error Resume Next
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: recurseSubFolders - " & Now()
GoTo exit_Sub

End Sub
'/=========================================/

This is the larger procedure...
--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

Option Explicit


'/================================/
' Sub Purpose:
' History:
' 07/15/2000 added hyperlink
' 07/17/2000 added filename filter
' 07/20/2000 added # files found info & criteria info
' 07/27/2000 added extension as separate column
' 08/03/2000 changed # files found to 'count' formula
' 10/23/2000 add status bar 'Wait' message
' 01/18/2007 change to FileDialog property
' 05/14/2009 change from FileSearch to recursive DIR
' for 2007 comparability (Dir Recursive
' basic concept from MrExcel.com)
'
'/================================/
'
Public Sub ListFilesToWorksheet()
Dim blnSubFolders As Boolean
Dim dblLastRow As Long
Dim R As Integer, x As Integer
Dim y As Integer, iWorksheets As Integer
Dim i As Long, j As Long, k As Long
Dim fso As Object
Dim Msg As String, strDirectory As String, strPath As String
Dim strResultsTableName As String, strFileName As String
Dim strWorksheetName As String
Dim strArr() As String
Dim strName As String
Dim strFileNameFilter As String, strDefaultMatch As String
Dim strExtension As String, strFileBoxDesc As String
Dim strMessage_Wait1 As String, strMessage_Wait2 As String
Dim varSubFolders As Variant, varAnswer As String

On Error Resume Next

'- - - - V A R I A B L E S - - - - - - - - -
strResultsTableName = "File_Listing"
strDefaultMatch = "*.*"
R = 1
i = 1
blnSubFolders = False
strMessage_Wait1 = _
"Please wait while search is in progress..."
strMessage_Wait2 = _
"Please wait while formatting is completed..."
ReDim strArr(1 To 65536, 1 To 3)
'- - - - - - - - - - - - - - - - - - - - - -

strFileNameFilter = _
InputBox("Ex: *.* with find all files" & vbCr & _
" blank will find all Office files" & vbCr & _
" *.xls will find all Excel files" & vbCr & _
" G*.doc will find all Word files beginning with G" _
& vbCr & _
" Test.txt will find only the files named TEST.TXT" _
& vbCr, _
"Enter file name to match:", Default:=strDefaultMatch)

If Len(strFileNameFilter) = 0 Then
varAnswer = _
MsgBox("Continue Search?", vbExclamation + vbYesNo, _
"Cancel or Continue...")
If varAnswer = vbNo Then
GoTo Exit_ListFiles
End If
End If

If Len(strFileNameFilter) = 0 Then
strFileBoxDesc = "*.*"
strFileNameFilter = "*.*"
Else
strFileBoxDesc = strFileNameFilter
End If

Msg = "Select location of files to be " & _
"listed or press Cancel."

'Allow user to select folder(s)
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = Left(ActiveWorkbook.FullName, _
Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.name))
.Title = Msg
.Show
strDirectory = .SelectedItems(1)
End With

If strDirectory = "" Then
Exit Sub
End If

If Right(strDirectory, 1) < Application.PathSeparator Then
strDirectory = strDirectory & Application.PathSeparator
End If

varSubFolders = _
MsgBox("Search Sub-Folders of " & strDirectory & " ?", _
vbInformation + vbYesNoCancel, "Search Sub-Folders?")

If varSubFolders = vbYes Then blnSubFolders = True
If varSubFolders = vbNo Then blnSubFolders = False
If varSubFolders = vbCancel Then Exit Sub

'check for an active workbook
' if no workbooks open, create one
If ActiveWorkbook Is Nothing Then
Workbooks.Add
End If

'save name of current worksheet
strWorksheetName = ActiveSheet.name

'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count

'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If UCase(Worksheets(x).name) = _
UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False 'turn warnings off
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True 'turn warnings on
Exit For
End If
Next

'Add new worksheet where results will be located
Worksheets.Add.Move after:=Worksheets(ActiveSheet.name)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").value = "Hyperlink"
ActiveWorkbook.ActiveSheet.Range("B1").value = "Path"
ActiveWorkbook.ActiveSheet.Range("C1").value = "FileName"
ActiveWorkbook.ActiveSheet.Range("D1").value = "Extension"
ActiveWorkbook.ActiveSheet.Range("E1").value = "Size"
ActiveWorkbook.ActiveSheet.Range("F1").value = "Date/Time"
Range("A1:E1").Font.Bold = True

R = R + 1

'get 1st filename
strName = Dir(strDirectory & strFileNameFilter)

On Error Resume Next
Application.StatusBar = strMessage_Wait1

'put filenames and file info into array
Do While strName < vbNullString
k = k + 1
strArr(k, 1) = strDirectory & strName
strArr(k, 2) = FileLen(strDirectory & strName)
strArr(k, 3) = FileDateTime(strDirectory & "\" & strName)
strName = Dir()
Loop

'get subfolder filenames if subfolder option selected
If blnSubFolders Then
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDirectory), _
strArr(), k, strFileNameFilter)
End If

'put file info on worksheet
If k 0 Then
For i = 1 To k
strFileName = ""
strPath = ""
For y = Len(strArr(i, 1)) To 1 Step -1
If Mid(strArr(i, 1), y, 1) = _
Application.PathSeparator Then
Exit For
End If
strFileName = _
Mid(strArr(i, 1), y, 1) & strFileName
Next y
strPath = _
Left(strArr(i, 1), _
Len(strArr(i, 1)) - Len(strFileName))
strExtension = ""
For y = Len(strFileName) To 1 Step -1
If Mid(strFileName, y, 1) = "." Then
If Len(strFileName) - y < 0 Then
strExtension = Right(strFileName, _
Len(strFileName) - y + 1)
' strExtension = Right(strFileName, _
Len(strFileName) - y)
strFileName = Left(strFileName, y - 1)
Exit For
End If
End If
Next y
Cells(R, 1) = strArr(i, 1)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(R, 1), _
Address:=strArr(i, 1)
Cells(R, 2) = strPath
Cells(R, 3) = strFileName
Cells(R, 4) = strExtension
Cells(R, 5) = FileLen(strArr(i, 1))
Cells(R, 6) = FileDateTime(strArr(i, 1))
R = R + 1
Next i
End If

'formatting
Application.StatusBar = strMessage_Wait2
ActiveWindow.Zoom = 75
Columns("E:E").Select
With Selection
.NumberFormat = _
"_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
End With
Columns("F:F").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Columns("A:F").EntireColumn.AutoFit
Columns("A:A").Select
If Selection.ColumnWidth 12 Then
Selection.ColumnWidth = 12
End If

Range("A2").Select
ActiveWindow.FreezePanes = True

Rows("1:1").Select
Selection.Insert Shift:=xlDown

dblLastRow = 65000

ActiveWorkbook.ActiveSheet.Range("A1").WrapText = False
If Len(strFileNameFilter) = 0 Then
strFileNameFilter = "*.*"
End If
If blnSubFolders Then
strDirectory = "(including Subfolders) - " & strDirectory
End If

Application.ActiveCell.Formula = "=SUBTOTAL(3,A3:A" & _
dblLastRow & ") & " & Chr(34) & _
" files(s) found for Criteria: " & _
strDirectory & strFileNameFilter & Chr(34)
Selection.Font.Bold = True

Range("B3").Select
Selection.Sort Key1:=Range("B3"), _
Order1:=xlAscending, Key2:=Range("A3") _
, Order2:=xlAscending, HEADER:=xlGuess, _
OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom

Range("A3").Select

Application.Dialogs(xlDialogWorkbookName).Show

Exit_ListFiles:
Application.StatusBar = False
Exit Sub

Err_ListFiles:
MsgBox "Error: " & Err & " - " & Err.Description
Resume Exit_ListFiles

End Sub

'/================================/
' Sub Purpose: recursive for filesearch 2007
'/================================/
'
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String

On Error GoTo err_Sub

For Each SubFolder In Folder.SubFolders
'get 1st filename in subfolder
strName = Dir(SubFolder.Path & "\" & searchTerm)
'put filenames and file info in subfolders into array
Do While strName < vbNullString
i = i + 1
strArr(i, 1) = SubFolder.Path & "\" & strName
strArr(i, 2) = FileLen(SubFolder.Path & "\" & strName)
strArr(i, 3) = FileDateTime(SubFolder.Path & "\" & strName)
strName = Dir()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next

exit_Sub:
On Error Resume Next
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: recurseSubFolders - Module: " & _
"Mod_Testing - " & Now()
GoTo exit_Sub

End Sub
'/================================/

To show only dates before a certain date (July 01, 2009 used in this
example), change the following to something like...

'show the results in the IMMEDIATE window
For i = 1 To k
If FileDateTime(strArr(i)) < DateValue("07/01/2009") Then
Debug.Print strArr(i) & " - " & FileDateTime(strArr(i))
End If
Next i

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"Stratuser" wrote:

Is there a date property for a file found by DIR? How do I specify that I
want only files before a certain date?



"Gary Brown" wrote:

You need to use a recursive DIR( ).
Check out Mr Excel's...
http://www.mrexcel.com/forum/showthr...=recursive+dir

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"Stratuser" wrote:

I need code that will look at all the files in a subdirectory and loop
through just the ones that are older than the first of the current month,
operating on them one at a time. I used to do this with the FileSearch
command, but that's gone in Excel 2007. How could I do it now?

Thanks for your help.