Monday, February 06, 2012
   
Text Size

VB - Date Last Access for Files in a Folder

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

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()
CheckFolder (FSO.getfolder(Search_Drive)), objStream

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

Sub CheckFolder(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
               CheckFolder objNewFolder, objLogFile
       Next
    
End Sub

Sub Create_WorkBook()

 'Create Objects for Input file and Excel Workbook

 'Place titles in workbook
 objXL.Workbooks.Add
 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 Accessed"
 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