macro to capture who accessed the Excel file

[cedmunds]

Anyone know of a way to capture who (user name, machine name etc.) had the excel file open when a certain cell is selected? a Macro?

Trying to use an Excel spreadsheet for a peer review where each reviewer accesses the Excel peer reivew file and enters the minutes they spent in the peer review but would like to also capture the user that had the file open when the minutes spent on the peer review were entered. This would provide proof that the actual peer reviewer opened the file and entered their minutes.

 

[Kenneth Hobson]

The key is to enable the Log before you enter the first data. Even if you are the one adding the initial data, when the user deletes the data, you then know from the log that you entered a data value and that user deleted it.

Or, run a macro to fill the Log sheet before you send the xls out for others to use.

 

[crimson_b1ade]

Of course none of the previous will work if the User disables macros.

 

[Firestorm]

A related question. How do we capture who (date, user name, machine name etc.) had actually opened the file without even changing anything in the file?

Thanks.

 

[VoG]

A related question. How do we capture who (date, user name, machine name etc.) had actually opened the file without even changing anything in the file?

Thanks.

One way would be to write the information to a text file.

 

[Kenneth Hobson]

There are several external methods to not modify the current xls. Standard text file methods using Append is easily done as VoG said. I already gave the MDB table writing method. You can write to DOC, XML, INI, other XLS files and the registry to name a few other methods.

 

[Firestorm]

Hi VoG & Kenneth Hobson,

Thank you. I need some help in capturing who opened the file.

As suggested it can be doen by using append. Whats the code like? Lets use the example that is extracted from this thread and appended below :

Thanks and regards.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
If Intersect(Target, Range("F15:F25")) Is Nothing Then Exit Sub
With Sheets("Log")
.Unprotect password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = Now
.Range("C" & NR).Value = Environ("username")
.Protect password:="xyz"
End With
End Sub

End Sub

 

[VoG]

The equivalent code would be something like

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long, iMyFreeFile As Integer
If Intersect(Target, Range("F15:F25")) Is Nothing Then Exit Sub
iMyFreeFile = FreeFile
Open "c:\xltext.txt" For Append As #iMyFreeFile
Write #iMyFreeFile, Target.Address(False, False), Format(Now, "dd/mm/yy hh:mm:ss"), Environ("username")
Close #iMyFreeFile
End Sub

 

[Kenneth Hobson]

Not sure what you really want. You asked for who opened the file. Obviously, you would need ThisWorkbook's Open event for that. My MDB example did that as does this. If need the Change event, you can easily adapt this or use VoG's example.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  AppendOpenClose "c:\temp\XLSOpenClose.txt", "Close"
End Sub

'MDB method, http://vbaexpress.com/forum/showthread.php?t=22620
Private Sub Workbook_Open()
  AppendOpenClose "c:\temp\XLSOpenClose.txt", "Open"
End Sub

Private Sub AppendOpenClose(strFile As String, wbEvent As String)
    Dim str As String
    str = ThisWorkbook.FullName & "," & wbEvent & "," & Environ("username") & "," & _
        Format(Now, "dd/mm/yy hh:mm:ss")
    AppendToTXTFile strFile, str
End Sub

Private Function AppendToTXTFile(strFile As String, strData As String) As Boolean
    Dim iHandle As Integer
    iHandle = FreeFile
    Open strFile For Append Access Write As #iHandle
    Print #iHandle, strData
    Close #iHandle
    AppendToTXTFile = True
End Function

 

[eherron]

Hi,
I need to add some functions to your Audit Trail macro. I added 2 functions already (worksheet name and data entered), but I need to add the previous data a reason for change (with a pop-up in the worksheet requesting the reason with a field in the pop-up for entering the reason, is possible). I found this macro, but I can't get it to apply PreviousValue to you macro:
Dim PreviousValue<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
If Target.Value <> PreviousValue Then<o></o>
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _<o></o>
Application.UserName & " changed cell " & Target.Address _<o></o>
& " from " & PreviousValue & " to " & Target.Value<o></o>
End If<o></o>
End Sub<o></o>
<o></o>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)<o></o>
PreviousValue = Target.Value<o></o>
End Sub
This is how I have modified your macro to give me the worksheet name and data entered:
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
Dim NR As Long<o></o>
Dim PreviousValue<o></o>
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub<o></o>
With Sheets("log")<o></o>
.Unprotect Password:="xyz"<o></o>
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1<o></o>
.Range("A" & NR).Value = Target.Address(False, False)<o></o>
.Range("B" & NR).Value = ActiveSheet.Name<o></o>
.Range("C" & NR).Value = Now<o></o>
.Range("D" & NR).Value = Environ("username")<o></o>
.Range("E" & NR).Value = Target.Value<o></o>
.Protect Password:="xyz"<o></o>
End With<o></o>
End Sub<o></o>
<o></o>
<o></o>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)<o></o>
<o></o>
End Sub
<o></o>
,which gives me in the "log" worksheet in columns A, B, C, D & E:
<TABLE style="WIDTH: 317pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=422><COLGROUP><COL style="WIDTH: 48pt" span=2 width=64><COL style="WIDTH: 125pt; mso-width-source: userset; mso-width-alt: 6070" width=166><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 height=20 width=64>I25</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 width=64>Sheet1</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 125pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 width=166> 10/4/2011 14:11</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 width=64>eherron</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 width=64>559</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 height=20>C18</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>Sheet1(2)</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66> 10/4/2011 14:12</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>eherron</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65>126</TD></TR></TBODY></TABLE>
I tried entering .Range("E" & NR).Value = Target.PreviousValue and .Range("E" & NR).Value = Target.PreviousValue with .Range("F" & NR).Value = Target.Value, but neither worked. Any ideas on how to make this work?

I could find nothing for adding a reason.