Monday, February 06, 2012
   
Text Size

VB - Data Last Modified

Set FSO = CreateObject("scripting.filesystemobject")
Set objXL = WScript.CreateObject("Excel.Application")
Search_Type = "3"

Search_Type = InputBox("Enter The type of Search (1. Users or Data , 2. Profiles", "Search Criteria", "1")
Search_Date = InputBox("Enter Date To Search From" & VBCRLF & VBCRLF & "Must Be In The Following Format 13/01/2003", "Search All Files on a Given Drive Letter.....","28/08/2003")
Search_Drive = InputBox("Enter The Drive Letter To Search" & VBCRLF & VBCRLF & "Paths Can Also Be Used - e.g C:\WINNT", "Search All Files in a Given Drive Letter.....","C:\")

Search_Date2 = DateValue(Search_Date)

Column = 1
Row = 1
CONST ForReading = 1, ForWriting = 2, ForAppending = 8

MSGBOX ("Search Date : " & Search_Date2 & VBCRLF & "Search Drive : " & Search_Drive)

'create the output file
Call Create_WorkBook()

If Search_Type = "1" Then
 CheckFolderUser (FSO.getfolder(Search_Drive)), objStream
Else
End If

If Search_Type = "2" Then
 CheckFolderProf (FSO.getfolder(Search_Drive)), objStream
Else
End If


'CheckFolder (FSO.getfolder(Search_Drive)), objStream

MsgBox "File Search Completed." + vbCr + "Please Switch to the open Excel Workbook to view the results."

Sub CheckFolderProf(objCurrentFolder, objLogFile)
      For Each objFile In objCurrentFolder.Files
           strTemp = Right(objFile.Name, 4)
                If objFile.datelastmodified <= (Search_Date2) Then
                    'Got one
                    If ObjFile.Name = "*.dat" Then
   strOutput = CStr(objFile.Name) + "," + CStr(objFile.Path) + "," + CStr(objFile.Size) + "," _
                          + CStr(objFile.Type) + "," + CStr(objFile.datelastmodified)

   Row = Row+1

   ObjXL.Cells(Row,Column).Value = objFile.Name
   objXL.Cells(Row,Column+1).Value = ObjFile.Path
   objXL.Cells(Row,Column+2).Value = ObjFile.Size
   objXL.Cells(Row,Column+3).Value = ObjFile.Type
   objXL.Cells(Row,Column+4).Value = ObjFile.datelastmodified
   objXL.Cells.EntireColumn.AutoFit
      Else
      End If
                End If
       Next

       'Recurse through all of the folders
       For Each objNewFolder In objCurrentFolder.subFolders
               CheckFolderProf objNewFolder, objLogFile
       Next
    
End Sub

Sub CheckFolderUser(objCurrentFolder, objLogFile)
     
       For Each objFile In objCurrentFolder.Files
           strTemp = Right(objFile.Name, 4)
                If objFile.datelastmodified <= (Search_Date2) Then
 'CHR(34) & Search_Date & CHR(34)
                    'Got one
                    strOutput = CStr(objFile.Name) + "," + CStr(objFile.Path) + "," + CStr(objFile.Size) + "," _
                          + CStr(objFile.Type) + "," + CStr(objFile.datelastmodified)

   Row = Row+1

   ObjXL.Cells(Row,Column).Value = objFile.Name
   objXL.Cells(Row,Column+1).Value = ObjFile.Path
   objXL.Cells(Row,Column+2).Value = ObjFile.Size
   objXL.Cells(Row,Column+3).Value = ObjFile.Type
   objXL.Cells(Row,Column+4).Value = ObjFile.datelastmodified
  objXL.Cells.EntireColumn.AutoFit
                End If
       Next

       'Recurse through all of the folders
       For Each objNewFolder In objCurrentFolder.subFolders
               CheckFolderUser objNewFolder, objLogFile
       Next
    
End Sub

Sub Create_WorkBook()

 'Create Objects for Input file and Excel Workbook

 'Place titles in workbook
 objXL.Workbooks.Add
 'If Search_Type = "1" Then
 ' ObjXL.Cells(Row,Colum).value = "USERS And DATA Area Search"
 ' Row = Row + 1
 'Else
 ' If Search_Type = "2" Then
 '  ObjXL.Cells(Row,Colum).Value = "Profiles Search"
 ' End If
 'End If
 objXL.Cells(Row,Column).Value = "Check Files on Drive - " & Search_Drive
 Row = Row+1
 objXL.Cells(Row,Column).Value = "The have NOT Been Accessed Since - " & Search_Date2
 Row = Row+1
 ObjXL.Cells(Row,Column).Value = "FileName"
 objXL.Cells(Row,Column+1).Value = "Full Path"
 objXL.Cells(Row,Column+2).Value = "File Size"
 objXL.Cells(Row,Column+3).Value = "File Type"
 objXL.Cells(Row,Column+4).Value = "Date Last Modified"
 objXL.Range("A1").Select
 objXL.Selection.Font.Bold = True
 objXL.Range("A2:F2").Select
 objXL.Selection.Font.Bold = True
 objXL.Range("A3:E3").Select
 objXL.Selection.Font.Bold = True
 objXL.Cells.Select
 objXL.Cells.EntireColumn.AutoFit
 objXL.Range("A1").Select
 objXL.Visible = True

End Sub