Macro to capture "Last Saved By" info in Excel 2

[jpkeller55]

Does anybody know how to capture the "Last Saved By" info from and excel spreadsheet using a macro? We have users in the field who send in reports on an excel spreadsheet and I am consolidating the data that is sent in on these excel forms into an Access database using the following code:

Sub DAOFromExcelToAccess()
'exports data from the active worksheet to a table in an Access Database

Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\Documents and Settings\jpkeller\My Documents\SystemSpeedReporting.mdb")
    'open the database
Set rs = db.OpenRecordset("IssuesTbl", dbOpenTable)
With rs
.AddNew
.Fields("Date") = Range("b" & 3).Value
.Fields("Time") = Range("b" & 4).Value
.Fields("Location") = Range("b" & 6).Value
.Fields("Desktop") = Range("b" & 8).Value
.Fields("Laptop") = Range("b" & 9).Value

.Fields("CitrixYes") = Range("b" & 11).Value
.Fields("CitrixNo") = Range("b" & 12).Value
.Fields("NetworkLine") = Range("b" & 14).Value
.Fields("VPNdial") = Range("b" & 15).Value
.Fields("VPNbroad") = Range("b" & 16).Value
.Fields("RxHome") = Range("b" & 18).Value
.Fields("Outlook") = Range("b" & 19).Value
.Fields("Word") = Range("b" & 20).Value
.Fields("Excel") = Range("b" & 21).Value
.Fields("Access") = Range("b" & 22).Value
.Fields("Adobe") = Range("b" & 23).Value
.Fields("Other") = Range("b" & 24).Value
.Fields("Description") = Range("b" & 26).Value

.Update
End With
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

This code is working fine but I would like to add a "Field" in this macro that would capture the "Last Saved By" info from the excel worksheet and populate that data into a field in Access.

I am sure the easy thing to do is have the users type in their name in the spreadsheet, but we are trying to make it as easy for them as possible and also the excel form has already been widely distributed and we do not want to send out an updated excel form.

THANKS! JPKELLER55

 

[PHV]

You may try ActiveWorkbook.BuiltinDocumentProperties("Last author")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[jpkeller55]

Beautiful, works perfectly! Thanks PHV!

 

[jpkeller55]

One other question...This is capturing the username as desired. Is there also a way to capture the time and date it was last saved? Thanks, JPKELLER55

 

[AnotherHiggins]

FWIW, when I capture "Last Author" info, I usually capture "Last Save Time" along with it.

ThisWorkbook.BuiltinDocumentProperties("Last Save Time").Value

That will return the date and time.



[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[AnotherHiggins]

Heh. Posted at the same time...

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.

 

[jpkeller55]

Thanks John! That works great...I guess you knew I would be wanting that information as well! You guys rock!

 

[jpkeller55]

In case anybody wants to know, here is the code with PHV's and anotherhiggins' additions for capturing the username and date/time. Works great.

Sub DAOFromExcelToAccess()
'exports data from the active worksheet to a table in an Access Database

Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\Documents and Settings\jpkeller\My Documents\SystemSpeedReporting.mdb")
    'open the database
Set rs = db.OpenRecordset("IssuesTbl", dbOpenTable)
With rs
.AddNew
.Fields("Date") = Range("b" & 3).Value
.Fields("Time") = Range("b" & 4).Value
.Fields("Location") = Range("b" & 6).Value
.Fields("Desktop") = Range("b" & 8).Value
.Fields("Laptop") = Range("b" & 9).Value

.Fields("CitrixYes") = Range("b" & 11).Value
.Fields("CitrixNo") = Range("b" & 12).Value
.Fields("NetworkLine") = Range("b" & 14).Value
.Fields("VPNdial") = Range("b" & 15).Value
.Fields("VPNbroad") = Range("b" & 16).Value
.Fields("RxHome") = Range("b" & 18).Value
.Fields("Outlook") = Range("b" & 19).Value
.Fields("Word") = Range("b" & 20).Value
.Fields("Excel") = Range("b" & 21).Value
.Fields("Access") = Range("b" & 22).Value
.Fields("Adobe") = Range("b" & 23).Value
.Fields("Other") = Range("b" & 24).Value
.Fields("Description") = Range("b" & 26).Value
.Fields("ReportedBy") = ActiveWorkbook.BuiltinDocumentProperties("Last author")
.Fields("LastSavedBy") = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time").Value  

.Update
End With
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub