Excel - Retrieving the last modified date of another workbook

[MISMonkey]

I have a number of users who each have a workbook for recording their time in. All the users workbooks are in the same network location (i.e. Employee 1.xls, Employee 2.xls...).

I need to create a 'Master' workbook (independent of these) that lists the employees and the date that their own workbook was last modified. The manager can then keep track of people and ensure individuals are entering their time daily.

What is the vba for retrieving the information from the properties box of an excel workbook? For simplicity let's say I have in Column A a list of names (Employee 1, Employee 2 etc...) - in column B I want the last modified date for a specific workbook to be displayed.

Any pointers greatly received!

I love deadlines. I like the whooshing sound they make as they fly by. (Douglas Adams)

 

[MISMonkey]

Got the following to work...
------------------------------------------------------------
Sub GetWorkbookProperties()
Dim fs As Variant
Dim f As Variant
Dim stModifiedDate As String
Dim stAccessedDate As String
Dim wbookpath As String
Dim wbookname As String

'sets the path and filename for a specific workbook
wbookpath = "mypath"
wbookname = "myworkbookname"

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(wbookpath & wbookname)

stModifiedDate = Left(f.DateLastModified, 10)
stAccessedDate = Left(f.DateLastAccessed, 10)

'writes the modified date to a specific cell in this workbook
Range("B4").Select
ActiveCell.FormulaR1C1 = stModifiedDate

'writes the accessed date to a specific cell in this workbook
Range("c4").Select
ActiveCell.FormulaR1C1 = stAccessedDate

End Sub
------------------------------------------------------------

Could be sweeter I know but this works. If anyone fancies trying to assume you know the path but the number and name of files can be dynamic and unknown - feel free. My version assumes you know the names of the people and the location of the workbooks and are prepared to code the master sheet acordingly.


I love deadlines. I like the whooshing sound they make as they fly by. (Douglas Adams)

 

[SkipVought]

Hi,

Here's the loop...

Sub GetWorkbookProperties()
    Dim fs As Object
    Dim f As Object
    Dim wbookpath As String
    Dim r As Range
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    wbookpath = "d:\My Documents\Spares"
    For Each r In Range([A2], [A2].End(xlDown))
        Set f = fs.GetFile(wbookpath & "\" & r.Value & ".xls")
        
        If Not f Is Nothing Then
            Cells(r.Row, "B").Value = Left(f.DateLastModified, 10)
            Cells(r.Row, "C").Value = Left(f.DateLastAccessed, 10)
        End If
    Next
End Sub

Skip,
[sub]
[red][/red]
[/sub]

 

[stevexff]

Alternative approach, drive it from what is found on the filesystem, not the list in the spreadsheet:

Sub fileList()

    Dim myFS As Scripting.FileSystemObject
    Set myFS = New Scripting.FileSystemObject
    Dim myFolder As Folder
    Set myFolder = myFS.GetFolder("\\admin\timesheets")
    
    For Each f In myFolder.Files
        Debug.Print f.Name & ":" & Left(f.DateLastModified, 10)
    Next
    
End Sub

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[MISMonkey]

Cheers All,

I have the following in place now (which I can't take full credit for because it is a group of bits of code I found on tek-tips in the past - so top marks to those who originally provided them!)

The user specifies the path of a folder to search in cell B2 (i.e "c:\mydocuments\"). the following code is atached to a refresh button that will paste the parsed full file name in cell A5 with the modified date and last opened date alongside it.
'--------------------------------------------------------

Sub SearchForExcelFileDetails()
Dim stFileName As String
Dim fsFileSearch As Variant
Dim fsFileDetails As Variant
Dim F As Variant
Dim stModifiedDate As String
Dim stAccessedDate As String
Dim wbookpath As String
Dim wbookname As String
Dim VAR_SLASH As Integer
Dim VAR_SLASH_FNL As Integer
Dim CHAR_SLASH As String
Dim FILE_STR As String

Application.ScreenUpdating = False

wbookpath = Range("b2") 'user has path typed in full in cell b2

Set fsFileSearch = Application.filesearch
With fsFileSearch
.LookIn = wbookpath 'sets the folder location to look in
.Filename = "*" 'wildcard used to limit list returned
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then

x = 5 'reset the counter (1 = row 1).this sets the top left reference point

'clear the 3 columns used for pasting data starting at the row assigned above
Range("a" & x & ":c1000").Select 'clears a fixed 1000 rows from the top left reference

Selection.ClearContents

For i = 1 To .FoundFiles.Count
wbookname = .FoundFiles(i) 'full file path, including file name and extension, of the files

'for each workbook found extract the .xls filename
For VAR_SLASH = 1 To 500
CHAR_SLASH = Left(Right(wbookname, VAR_SLASH), 1)
If CHAR_SLASH = "\" Then
VAR_SLASH_FNL = VAR_SLASH
Exit For
Else
End If
Next VAR_SLASH

FILE_STR = Right(wbookname, VAR_SLASH_FNL - 1)

Cells(x, 1).Select 'sets the starting point for the paste of the file name
ActiveCell.FormulaR1C1 = FILE_STR 'write the .xls filename to the sheet

'gets the last modified date for the file

Set fsFileDetails = CreateObject("Scripting.FileSystemObject")
Set F = fsFileDetails.GetFile(wbookname) 'uses the full filepath name

stModifiedDate = (Format(Left(F.DateLastModified, 10), "long date"))
stAccessedDate = (Format(Left(F.DateLastAccessed, 10), "long date"))

Cells(x, 2).Select 'sets the starting point for the paste of the modified date
ActiveCell.FormulaR1C1 = stModifiedDate 'write the filename to the sheet

Cells(x, 3).Select 'sets the starting point for the paste of the modified date
ActiveCell.FormulaR1C1 = stAccessedDate 'write the filename to the sheet

x = x + 1 'moves the active row for pasting to the next one down
Next i
Else
MsgBox "There were no files found."
End If
End With
Application.ScreenUpdating = True
End Sub


I love deadlines. I like the whooshing sound they make as they fly by. (Douglas Adams)

 

[thumbtwiddler]

Very useful - thx. If I have want to cycle through a ragged heirarchy of subfolders, would this be an easy thing to add?

Thanks in advance

 

[thumbtwiddler]

Doh, ignore last email - all I needed to add in was

.SearchSubFolders = True 'sets the search to go through subfolders as well

My bad, should really have tested this before asking.

Apologies