Excel中跟踪记录工作簿打开及关闭操作
日常工作中,有时出于安全与权限的要求,我们需要跟踪记录Excel文件被谁何时打开及关闭,要实现这一功能我们需要在ThisWorkbook模块中添加事件代码,同时添加一个隐藏的工作表(命名为shtAudit,属性为xlVeryHidden),添加到ThisWorkbook模块中的事件代码如下:
'================================ ' Excel中跟踪记录工作簿打开及关闭操作 ' ' '================================ Private Declare Function GetUserName _ Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private Declare Function GetComputerName _ Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private pAuditSheet As Worksheet Private Const USERNAME_COL = 1 Private Const COMPUTERNAME_COL = 2 Private Const OPEN_TIME_COL = 3 Private Const CLOSE_TIME_COL = 4 Private Const OPEN_WB_NAME_COL = 5 Private Const CLOSE_WB_NAME_COL = 6 Private Const KEEP_ONLY_LAST_N_ENTRIES = 10 Private Sub Workbook_Open() Dim WS As Worksheet Dim RowNum As Long Dim N As Long Dim S As String Application.ScreenUpdating = False On Error Resume Next Err.Clear Set WS = Me.Worksheets("shtAudit") If Err.Number = 9 Then Set WS = Me.Worksheets.Add(before:=1) WS.Name = "Audit" End If On Error GoTo 0 With WS If .Cells(1, USERNAME_COL).Value = vbNullString Then .Cells(1, USERNAME_COL).Value = "User Name" .Cells(1, COMPUTERNAME_COL).Value = "Computer Name" .Cells(1, OPEN_TIME_COL).Value = "Open Time" .Cells(1, CLOSE_TIME_COL).Value = "Close Time" .Cells(1, OPEN_WB_NAME_COL).Value = "Open WB Name" .Cells(1, CLOSE_WB_NAME_COL).Value = "Close WB Name" End If .Visible = xlSheetVeryHidden RowNum = .Cells(.Rows.Count, USERNAME_COL).End(xlUp)(2, 1).Row N = 255 S = String(N, vbNullChar) N = GetUserName(S, N) .Cells(RowNum, USERNAME_COL).Value = TrimToNull(S) N = 255 S = String(N, vbNullChar) N = GetComputerName(S, N) .Cells(RowNum, COMPUTERNAME_COL).Value = TrimToNull(S) .Cells(RowNum, OPEN_TIME_COL).Value = Now ' Leave Close Time empty. It will be filled on close. .Cells(RowNum, CLOSE_TIME_COL).Value = vbNullString .Cells(RowNum, OPEN_WB_NAME_COL).Value = ThisWorkbook.FullName ' Leave Close Name empty. It will be filled on close. .Cells(RowNum, CLOSE_WB_NAME_COL).Value = vbNullString .UsedRange.Columns.AutoFit End With Application.ScreenUpdating = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim WS As Worksheet Dim RowNum As Long Dim EndRow As Long Dim LastDel As Long Dim FirstDel As Long Application.ScreenUpdating = False Set WS = Worksheets("shtAudit") With WS RowNum = .Cells(.Rows.Count, CLOSE_TIME_COL).End(xlUp).Row + 1 .Cells(RowNum, CLOSE_TIME_COL).Value = Now .Cells(RowNum, CLOSE_WB_NAME_COL).Value = ThisWorkbook.FullName .UsedRange.Columns.AutoFit If KEEP_ONLY_LAST_N_ENTRIES > 0 Then EndRow = .Cells(.Rows.Count, USERNAME_COL).End(xlUp).Row If EndRow > 2 Then FirstDel = 2 LastDel = EndRow - KEEP_ONLY_LAST_N_ENTRIES If LastDel > 2 Then .Cells(FirstDel, "A").Resize(LastDel - 1, 1).Select End If End If End If End With Application.ScreenUpdating = True End Sub Private Function TrimToNull(S As String) As String Dim N As Long N = InStr(1, S, vbNullChar) If N = 0 Then TrimToNull = S Else TrimToNull = Left(S, N - 1) End If End Function
相关示例文件下载:Excel中跟踪记录工作簿打开及关闭操作示例文件 (2337)
Excel on 四月 13th, 2010
请问怎么看不到跟踪的记录呀?
CnHUP on 四月 13th, 2010
跟踪记录的工作表是隐藏属性的,打开Visual Basic编辑器(Alt+F11)后设定shtAudit工作表的Visible属性为xlSheetVisible,这样就可以看到跟踪的记录了。