Barb said: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.
Jake said:Hi Barb,
Barb said: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?
Jake said:Hi Barb,
Barb said: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 said:Hi Greg,
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 said: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
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.