View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
GregR GregR is offline
external usenet poster
 
Posts: 246
Default Finding the earliest "Last Saved Date" of Excel workbooks

Jake, thanks worked like a charm. If I may impinge on you for one more
question, If I want to include subfoders ( one level) and report the
last modified in each subfolder is there much of a modification. TIA

Greg
Jake Marx wrote:
Hi Greg,

GregR wrote:
Jake, to modify it to give the latest file do I just change DtMin to
DtMax?


You'd have to change a few things (most are cosmetic), but not much:

1) do a find/replace on dtMin -- dtMax

2) do a find/replace on mbFindEarliestLastModifiedInFolder --
mbFindLastModifiedInFolder

3) change this line:

MsgBox "The earliest last modified file in '" & rsFolderPath
to
MsgBox "The last modified file in '" & rsFolderPath

4) change this line:

dtMax = Now()
to
dtMax = 0

5) change this line:

If dtCurr < dtMax Then
to
If dtCurr dtMax Then


I think that's it. The most important changes are in 4 & 5 - the others are
cosmetic only.

--
Regards,

Jake Marx
www.longhead.com


[please keep replies in the newsgroup - email address unmonitored]

Jake Marx wrote:
Hi Barb,

Barb Reinhardt wrote:
Can this be done. I have a series of folders for week ending
reports. Within those folders are several subfolders. What I want
to know is what is the first "last saved date" of any Excel
workbooks within those folders.

You can use the Scripting.FileSystemObject to do this type of thing.
Here's some code that you can use to find the earliest last modified
Excel workbook in a given folder. Just call it like this:

Demo "c:\"

Here's the code:

Public Sub demo(rsFolderPath As String)
Dim sPath As String
Dim dtMin As Date

If mbFindEarliestLastModifiedInFolder(rsFolderPath, _
sPath, dtMin) Then
MsgBox "The earliest last modified file in '" & rsFolderPath
& _ "' is '" & sPath & "' with a date of " & Format$(dtMin,
_ "mm/dd/yyyy hh:mm:ss") & ".", vbInformation, "Last
Modified Date" Else
MsgBox "No Excel workbooks found in '" & rsFolderPath &
"'.", _ vbInformation, "Last Modified Date"
End If
End Sub

Private Function mbFindEarliestLastModifiedInFolder(rsFolderPath _
As String, rsFilePath As String, rdtLastModified As Date) As Boolean
Dim fso As Object
Dim fil As Object
Dim dtMin As Date
Dim dtCurr As Date
Dim sMinPath As String

On Error GoTo ErrHandler

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(rsFolderPath) Then
dtMin = Now()
For Each fil In fso.GetFolder(rsFolderPath).Files
If StrComp(fil.Type, "Microsoft Excel Worksheet", _
vbTextCompare) = 0 Then
dtCurr = fil.DateLastModified
If dtCurr < dtMin Then
dtMin = dtCurr
sMinPath = fil.Path
End If
End If
Next fil

rsFilePath = sMinPath
rdtLastModified = dtMin

mbFindEarliestLastModifiedInFolder = Len(rsFilePath)
End If

ExitRoutine:
Set fso = Nothing
Exit Function
ErrHandler:
Debug.Print Err.Number & ": " & Err.Description
Select Case Err.Number
Case 429
MsgBox "Error creating FileSystemObject.",
vbExclamation, _ "Error"
Case Else
MsgBox "Unexpected error:" & vbLf & vbLf & Err.Number & _
": " & Err.Description, vbCritical, "Error"
End Select
Resume ExitRoutine
End Function

Private Function mdtGetLastModified(rsFullPath As String) As Date
Dim fso As Object
Dim fil As Object

On Error GoTo ErrHandler

Set fso = CreateObject("Scripting.FileSystemObject")

Set fil = fso.GetFile(rsFullPath)
mdtGetLastModified = fil.DateLastModified

ExitRoutine:
Set fso = Nothing
Exit Function
ErrHandler:
Debug.Print Err.Number & ": " & Err.Description
Select Case Err.Number
Case 429
MsgBox "Error creating FileSystemObject.",
vbExclamation, _ "Error"
Case 53
MsgBox "Invalid file path '" & rsFullPath & "'.", _
vbExclamation, "Error"
Case Else
MsgBox "Unexpected error:" & vbLf & vbLf & Err.Number & _
": " & Err.Description, vbCritical, "Error"
End Select
Resume ExitRoutine
End Function

--
Regards,

Jake Marx
www.longhead.com


[please keep replies in the newsgroup - email address unmonitored]