PDA

View Full Version : Solved: Create A List Of ALL Files On Disk Changed...



Wolfgang
07-28-2006, 09:30 AM
Good Evening Knowledgeables?

Is it possible using Excel to generate a list of ALL files on drive C which have been altered at the current day?!

Thank you very much in advance?

Best,

Wolfgang

Bob Phillips
07-28-2006, 11:01 AM
This should do it




Sub ProcessFiles()
Dim i As Long
Dim sFolder As String
Dim FSO As Object
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
If Int(fiel.datelastmodified) = Date Then
Debug.Print file.Name
End If
End If
Next file

End If ' sFolder <> ""

End Sub

Wolfgang
07-28-2006, 11:50 AM
Hi xld...

Thanxs for your answer.

I tried your code and Excel barks at the following line of the code:

If Int(fiel.datelastmodified) = Date Then

Saying "Object required..."

Best,
Wolfgang

lucas
07-28-2006, 12:13 PM
If Int(fiel.datelastmodified) = Date Then
should be

If Int(file.datelastmodified) = Date Then


Bob accidently mispelled file

Wolfgang
07-28-2006, 12:30 PM
Hi Lucas...

thanx to you too.
The error message is gone now, but there are no results listed and if I understand Bob's macro clearly then his code will only list changed Excel files.

What I like to have is a list of all files changed, no matter what type...they could include windows .tmp files as well.

So, I like the macro to search through all of the folders of drive C: if possible, please...

Best,
Wolfgang

You know: In theory, there is no difference between theory and practice. In practice, there is…

matthewspatrick
07-28-2006, 12:44 PM
Wolfgang,

This ought to do it. It includes a couple of stray Select statements that are not strictly necessary, as most of the code dates back to a time when I still had some bad habits:whip

The code started its life as a way to list files in a directory and its subdirectories; I've modified it to look just for stuff that changed today.



Option Explicit
' Code based on procedures found at:
' http://www.exceltip.com/show_tip/Files,_Workbook,_and_Worksheets_in_VBA/
' List_files_in_a_folder_with_Microsoft_Scripting_Runtime_using_VBA_in_Micros oft_Excel/446.html
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long
Dim x As Long
Dim pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Sub DoListFilesInFolder()

Dim CheckPath As String
Dim Msg As Byte
Dim Drilldown As Boolean

CheckPath = GetDirectory()

If CheckPath = "" Then
MsgBox "No folder was selected. Procedure aborted.", vbExclamation, "StaffSmart Add-In"
Exit Sub
End If

Msg = MsgBox("Do you want to list all files in descendant folders, too?", _
vbInformation + vbYesNo, "Drill-Down")
If Msg = vbYes Then Drilldown = True Else Drilldown = False

Workbooks.Add ' create a new workbook for the file list
ActiveWindow.Zoom = 75
' add headers
With Range("A1")
.Formula = "Folder contents: "
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "Folder:"
Range("B3").Formula = "File Name:"
Range("C3").Formula = "File Size:"
Range("D3").Formula = "File Type:"
Range("E3").Formula = "Date Created:"
Range("F3").Formula = "Date Last Accessed:"
Range("G3").Formula = "Date Last Modified:"
Range("H3").Formula = "Attributes:"
Range("A3:H3").Font.Bold = True
ListFilesInFolder CheckPath, Drilldown
' list all files included subfolders
Range("a4").Select
ActiveWindow.FreezePanes = True
Range("a3").Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4"), _
Order2:=xlAscending, Header:=xlYes
Range("H3").AddComment
With Range("H3").Comment
.Visible = False
.Text Text:="The file attribute can have any of the following values " & _
"or any logical combination of the following values:" & Chr(10) & _
"0 = Normal file. No attributes are set. " & Chr(10) & _
"1 = Read-only file" & Chr(10) & _
"2 = Hidden file" & Chr(10) & _
"4 = System file" & Chr(10) & ""
.Text Text:=Chr(10) & "8 = Disk drive volume label " & Chr(10) & _
"16 = Folder or directory " & Chr(10) & _
"32 = File changed since last backup " & Chr(10) & _
"64 = Link or shortcut " & Chr(10) & _
"128 = Compressed file" & Chr(10) & Chr(10) & _
"For example, 3 = Read-only and Hidden", Start:=200
.Shape.Height = 200
.Shape.Width = 144
End With

Range("a1") = Range("a1").Value & CheckPath & IIf(Drilldown, " (with descendants)", _
" (without descendants)")
Range("a3").Select

ActiveWindow.LargeScroll Up:=100

MsgBox "Done", vbOKOnly, "StaffSmart Add-In"

End Sub
Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
If FileItem.DateLastModified >= Date Then
' display file properties
Cells(r, 1).Formula = FileItem.ParentFolder.path '& FileItem.Name
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.Type
Cells(r, 5).Formula = FileItem.DateCreated
Cells(r, 6).Formula = FileItem.DateLastAccessed
Cells(r, 7).Formula = FileItem.DateLastModified
Cells(r, 8).Formula = FileItem.Attributes
r = r + 1 ' next row number
End If
Next FileItem
' If "descendant" folders also get their files listed, then sub calls itself recursively
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If

Columns("A:H").AutoFit

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

End Sub

OBP
07-28-2006, 12:58 PM
Have a look at the Excel FileSearch Function.

Wolfgang
07-28-2006, 01:00 PM
Hi Patrick,

that did it...

Thank you very much for that...it only needs a Reference to Microsoft Scripting Runtime...

It runs just fine..despite the 47 degrees Celsius that we enjoyed today...

Have a nice weekend and thank you all again...

Best,
Wolfgang

matthewspatrick
07-28-2006, 01:02 PM
Wolfgang,

Be advised that any FileSystemObject approach might a long time if you really want to go through every file in C: and its descendant directories...

matthewspatrick
07-28-2006, 01:06 PM
Thank you very much for that...it only needs a Reference to Microsoft Scripting Runtime...

You're welcome, and sorry I neglected to mention the reference. Here is a replacement snippet that eliminates the need for a reference:





'everything above here is OK
Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
'everything below here is OK

Wolfgang
07-28-2006, 01:25 PM
Patrick...

don't worry...it only took less than 1:30 Minutes to scan some 50.000 folders...I did add Application.ScreenUpdating = False, though.

...on a Fujitsu-Siemens AMD Turion64 Laptop, German XP-Home with Office 2003 Pro US-Version...

Not bad...

Best,
Wolfgang

matthewspatrick
07-28-2006, 02:35 PM
don't worry...it only took less than 1:30 Minutes to scan some 50.000 folders


That's not bad. I was worried it would be worse :)


...I did add Application.ScreenUpdating = False, though.

Like I wrote, old code and bad habits :doh:

Glad to help!