Date Modified File Organization

[Roadsignologist]

Hello All,
I have a serious problem which I will try to explain as clear as possible.
I am trying to archive old folders based on the date its files we're modified.

There are a couple conditions though:
1. I want to move the entire path including the files to a new directory.
2. If there is one or more files in any sub-folder that was modified after
12/31/05 then do not move anything.

So in laments terms:
If all FILES in the folder we're modified before 12/31/05 then move from
S:\AS BUILTS\ *PATH* to S:\OLD PROJECTS\ *PATH*
Otherwise do nothing.
(FYI. Date Modified of the folders themselves is disregarded)

I have a list already created from the windows search of all files modified
on or before 12/31/05 in columns as

Name / In Folder / Size / Type / Modified
A301AV415.zip S:\AS BUILTS\AQR\12443\Arch 1,301 KB WinRAR ZIP
archive 4/19/04 8:51 AM

I can create a list of all the files if that helps.

Is this possible with Excel?

Thanks So Much - Jeff

 

[Dave Peterson]

First, this kind of thing always scares me. It's really easy to make a mistake
and screw things up. So make sure you have backups and test the heck out of it
before you trust it!

Second, I took lots of code from Ron de Bruin's site:
http://www.rondebruin.nl/fso.htm
In particular, this text version:
http://www.rondebruin.nl/files/mergecode.txt

Third, I used an API function that Jim Rech posted:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub Test()
MakeDir "c:\aaa\bbb"
End Sub

Sub MakeDir(DirPath As String)
If Right(DirPath, 1) <> "\" Then DirPath = DirPath & "\"
MakePath DirPath
End Sub

===========================================================================
If you want to try (test and verify before you trust it!!!):

Option Explicit
Private Fnum As Long
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Sub testme()
Dim myStartingFolder As String
Dim myDestFolder As String
Dim myDestSubFolder As String
Dim myCount As Long
Dim mySubFolder As Object
Dim FSO As Object

myStartingFolder = "S:\AS BUILTS\"
If Right(myStartingFolder, 1) <> "\" Then
myStartingFolder = myStartingFolder & "\"
End If

myDestFolder = "S:\OLD PROJECTS"
If Right(myDestFolder, 1) <> "\" Then
myDestFolder = myDestFolder & "\"
End If
MakePath myDestFolder

Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.folderexists(myStartingFolder) = False Then
MsgBox "Invalid starting folder!"
Exit Sub
End If

For Each mySubFolder In FSO.getfolder(myStartingFolder).Subfolders
myCount = CountOfFiles(myPath:=mySubFolder.Path, _
Subfolders:=True, _
ExtStr:="*.*", _
CutOffDate:=DateSerial(2006, 1, 1))

If myCount = 0 Then
'nothing new in this branch
FSO.MoveFolder _
Source:=mySubFolder.Path, _
Destination:=myDestFolder
End If

Next mySubFolder
End Sub
Function CountOfFiles(myPath As String, Subfolders As Boolean, _
ExtStr As String, _
CutOffDate As Date) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Fnum = 0

If Fso_Obj.folderexists(myPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.getfolder(myPath)

For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
If file.datelastmodified >= CutOffDate Then
Fnum = Fnum + 1
Exit For
End If
End If
Next file

If Fnum > 0 Then
'don't bother looking for more
Else
'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call LookInSubFolders(OfFolder:=RootFolder, _
FileExt:=ExtStr, CutOffDate:=CutOffDate)
End If
End If

CountOfFiles = Fnum
End Function
Sub LookInSubFolders(OfFolder As Object, _
FileExt As String, _
CutOffDate As Date)

Dim SubFolder As Object
Dim fileInSubfolder As Object

For Each SubFolder In OfFolder.Subfolders
LookInSubFolders OfFolder:=SubFolder, _
FileExt:=FileExt, CutOffDate:=CutOffDate

For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
If fileInSubfolder.datelastmodified >= CutOffDate Then
Fnum = Fnum + 1
Exit For
End If
End If
Next fileInSubfolder

If Fnum > 0 Then
Exit For
End If
Next SubFolder
End Sub


Do your testing and have backups!

 

[Roadsignologist]

OH MAN! This does look scary! I'll back it up and try it.

By the way
Declare Function MakePath Lib "imagehlp.dll" Alias _
is that file basically just a place holder that will get over written by
which ever file is being looked at for the time being?

 

[Dave Peterson]

Nope.

That's one of the mysterious API's that Windows uses. This one will check to
see if a folder exits. If it doesn't exist, it'll create it.