File Search using ScriptingRuntime:   Return to List

' 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



Note to Webmaster