XL For Search Tool

[bedsingar]

Hello, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I'm currently doing a project at work where I would need to identify a group of files, which have been updated in the last week, that have a specific file property. These Files would be in a mapped drive - or any sub folder of that mapped drive. <o></o>
<o></o>
I've used this code to do a similar task before: <o></o>
<o></o>
With Application.FileSearch
.LookIn = path & "\"
.FileType = msoFileTypeExcelWorkbooks
.Execute
nofiles = .FoundFiles.Count
End With<o></o>
<o></o>
but this won't check subfolders, and this time rather than just checking xls files I want it to check all files.<o></o>
<o></o>
I also need to be able to define a date range - I.E files modified in the last week. <o></o>
<o></o>
I need the macro to check that the custom file property "Processed" is currently set to 0.<o></o>
<o></o>
Then. collect the file path of all matching entries & report them in an excel file (Hyperlinked) <o></o>
<o></o>
I think its doable - although I'm not sure how efficient it will be. - None the less I'm using it with a mapped SharePoint drive & windows default functionality is not adequate for my needs! <o></o>
<o></o>
Thanks for your help<o></o>
<o> </o>
<o> </o>

 

[bedsingar]

Almost there... The following code works - except for the second section of PropertyTests which I want to check for a custom file property. - Any Ideas how I do this ?!

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 = "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

'no older than a week

.PropertyTests.Add Name:="Last Modified", _
Condition:=msoConditionAnytimeBetween, _
Value:="06/17/2011", SecondValue:="06/17/2011", _
Connector:=msoConnectorAnd

.PropertyTests.Add Name:="Processed", _
Condition:=CustomDocumentProperties("Processed"), _
Value:=0

On Error GoTo 2
Sheets.Add.Name = "Results"

'Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
On Error GoTo 1
2:
'ws = "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
Sheets("Results").Cells(z + 1, 1).Resize(, 4) = _
Array(Dir(Fil), _
FileLen(Fil) / 1000, _
FileDateTime(Fil), _
FPath)
Sheets("Results").Hyperlinks.Add Anchor:=Cells(z + 1, 1), _
Address:=.FoundFiles(i)
End If
End If
Next i
End If
End With

ActiveWindow.DisplayHeadings = False

With Sheets("Results")
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("Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub