' Must include a reference to "Windows Scripting Runtime" module
Dim fso As New FileSystemObject
Dim fld As Folder
Dim lSize As Long
Dim DirString As String
Dim OldPath As String
Private Sub cmdSearch_Click()
Dim nDirs As Integer
Dim nFiles As Integer
Dim sDir As String
Dim sSrchString As String
If cmdSearch.Caption <> "Cancel" Then
List1.Clear
End If
' When the process is running and cancel is pressed -- the macro will detect it If cmdSearch.Caption = "Cancel" Then
cmdSearch.Caption = "Canceled"
Exit Sub
End If
' Check for a valid drive letter entered by the User If txtDriveLtr.Text Like "[!A-Za-z]" Then
MsgBox "Must enter an alpha character for Drive Letter!" & vbCrLf & vbCrLf & _
" Please Try Again.", vbOKOnly, "Drive Letter Error"
txtDriveLtr.SetFocus
Exit Sub
Else
sDir = UCase(txtDriveLtr.Text) & ":\"
End If
' Check to see if a search string is entered If Len(txtSearchString.Text) = 0 Then
MsgBox "Must enter a search string for Directories or Files!" & vbCrLf & vbCrLf & _
" Please TRY AGAIN.", vbOKOnly, "Search String Error"
txtSearchString.SetFocus
Exit Sub
Else
sSrchString = txtSearchString.Text
If optDirectories.Value = True Then
DirString = txtSearchString.Text
End If
End If
MousePointer = 11
cmdSearch.Caption = "Cancel"
lblPath.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
MousePointer = 0
If cmdSearch.Caption = "Canceled" Then
lblPath.Caption = "Search Canceled"
cmdSearch.Caption = "Search"
Else
lblPath.Caption = "Search Complete"
cmdSearch.Caption = "Search"
End If
End Sub
Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Integer, nFiles As Integer) As Long
Dim MyFolder As Folder
Dim MyFile As File
Dim FileName As String
Dim f
If cmdSearch.Caption = "Canceled" Then
Exit Function
End If
Dim shit As String
Set fld = fso.GetFolder(sFol)
If optDirectories.Value = True Then
If InStr(UCase(sFol), UCase(DirString)) > 0 Then
NewPath = sFol
If NewPath <> OldPath Then
List1.AddItem sFol
OldPath = NewPath
nFiles = nFiles + 1
End If
End If
Else
If sFol <> "C:\System Volume Information" Then
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
Set f = fso.GetFile(fso.BuildPath(fld.Path, FileName))
'check for files that are older than value in label
shit = f.DateLastModified
If Len(txtNumberofDays.Text) > 0 Then
If f.DateLastModified > Now() - Val(txtNumberofDays.Text) Then
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
NewPath = fld.Path
If NewPath <> OldPath Then
List1.AddItem fld.Path ' Load ListBox
OldPath = NewPath
End If
End If
Else
FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
nFiles = nFiles + 1
NewPath = fld.Path
If NewPath <> OldPath Then
List1.AddItem fld.Path' Load ListBox OldPath = NewPath
End If
End If
FileName = Dir() ' Get next file
DoEvents
Wend
End If
End If
lblPath = "Searching " & vbCrLf & fld.Path
nDirs = nDirs + 1
lbldir.Caption = nDirs
If sFol <> "C:\System Volume Information" Then
If fld.SubFolders.Count > 0 Then
For Each MyFolder In fld.SubFolders
'below are directories you want to skip
If MyFolder <> "C:\Recycler" Then
DoEvents
FindFile = FindFile + FindFile(MyFolder.Path, sFile, nDirs, nFiles)
End If
Next
End If
End If
lblFiles.Caption = nFiles
End Function
Private Sub Form_Load()
optDirectories.Value = True
End Sub