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.

Thanks in advance,
Barb Reinhardt

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]

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

Greg
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]

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]

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]

Hi Greg,

GregR wrote:
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

No problem. To do this, you could use recursion on the Demo subroutine.
However, this will traverse all subfolders of the folder you pass in (not
just one level):

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

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

Set fso = CreateObject("Scripting.FileSystemObject")
For Each fol In fso.getfolder(rsFolderPath).Subfolders
demo fol.Path
Next fol

Set fso = Nothing
End Sub

If you want just one level, you could try this:

Public Sub demo(rsFolderPath As String, rsOrigFolderPath As String)
Dim sPath As String
Dim dtMin As Date
Dim fso As Object
Dim fol As Object

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



If rsFolderPath = rsOrigFolderPath Then
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fol In fso.getfolder(rsFolderPath).Subfolders
demo fol.Path, rsOrigFolderPath
Next fol
Set fso = Nothing
End If
End Sub


--
Regards,

Jake Marx
www.longhead.com


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