I found the code below on the board some years ago and it works great but it needs to evolve to match my department’s needs. Is it possible to track the original file name when it was opened and its path, instead of typing that information into the origname variable?
Scenario
Joe opens "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" and saves it as “Joe bidding.xls”, then Sally saves “Joe bidding.xls” it as “Sally Bidding.xls” Is it possible to see an audit trail for Sally’s file tracing through Joe’s file to the original "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" and the directory in which the file is located?
Desired Outcome:
User Joe.csv file will show the following:
Directory and saved name: C:\Joe bidding.xls
Format(Date, "0"): Date
User name: Joe
Directory and source file: C:\Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt
User Sally.csv file will show the following:
Directory and saved name: C:\Sally Bidding.xls
Format(Date, "0"): Date
User name: Sally
Directory and source file: C:\Joe bidding.xls
I have spent days working this and any help is appreciated, Thanks.
----------------------------------------------
This code will save a file per user and will track the saved file name, date, time, user name, and the original source file name when the workbook is closed.
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Sub Workbook_BeforeClose(cancel As Boolean)
origname = "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" '************************* PUT THE FILENAME HERE
On Error GoTo carryon
' This bit gets the logon userid
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
f_name = ActiveWorkbook.Name
fname = UserName
fn = FreeFile
' the folder below must have universal read-write access, or the user cannot create the file
' will create a fle for each user - filename = xxx.csv, where xxx is the user's logon userid
Open "I:\dept\BusinessManagement_32300_FW\Matt\Excel\MISC\BB\" & fname & ".csv" For Append As fn
' will record every time the user closes the file
Dim x(6)
'add filename ,date, time and user to file
x(1) = f_name
x(2) = Format(Date, "0")
x(3) = Format(Time, "HH:MM:SS")
x(4) = UserName
x(5) = origname
Write #fn, x(1), x(2), x(3), x(4), x(5)
Close #fn
Exit Sub
carryon:
Close #fn
End Sub
Scenario
Joe opens "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" and saves it as “Joe bidding.xls”, then Sally saves “Joe bidding.xls” it as “Sally Bidding.xls” Is it possible to see an audit trail for Sally’s file tracing through Joe’s file to the original "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" and the directory in which the file is located?
Desired Outcome:
User Joe.csv file will show the following:
Directory and saved name: C:\Joe bidding.xls
Format(Date, "0"): Date
User name: Joe
Directory and source file: C:\Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt
User Sally.csv file will show the following:
Directory and saved name: C:\Sally Bidding.xls
Format(Date, "0"): Date
User name: Sally
Directory and source file: C:\Joe bidding.xls
I have spent days working this and any help is appreciated, Thanks.
----------------------------------------------
This code will save a file per user and will track the saved file name, date, time, user name, and the original source file name when the workbook is closed.
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Sub Workbook_BeforeClose(cancel As Boolean)
origname = "Standard Bidding Form 2008 Temp(03-17-08 Rates).xlt" '************************* PUT THE FILENAME HERE
On Error GoTo carryon
' This bit gets the logon userid
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
f_name = ActiveWorkbook.Name
fname = UserName
fn = FreeFile
' the folder below must have universal read-write access, or the user cannot create the file
' will create a fle for each user - filename = xxx.csv, where xxx is the user's logon userid
Open "I:\dept\BusinessManagement_32300_FW\Matt\Excel\MISC\BB\" & fname & ".csv" For Append As fn
' will record every time the user closes the file
Dim x(6)
'add filename ,date, time and user to file
x(1) = f_name
x(2) = Format(Date, "0")
x(3) = Format(Time, "HH:MM:SS")
x(4) = UserName
x(5) = origname
Write #fn, x(1), x(2), x(3), x(4), x(5)
Close #fn
Exit Sub
carryon:
Close #fn
End Sub