Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As LongPrivate Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As LongPrivate pAuditSheet As WorksheetPrivate Const USERNAME_COL = 1Private Const COMPUTERNAME_COL = 2Private Const OPEN_TIME_COL = 3Private Const CLOSE_TIME_COL = 4Private Const OPEN_WB_NAME_COL = 5Private 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("跟踪") If Err.Number = 9 Then Set WS = Me.Worksheets.Add(before:=1) WS.Name = "跟踪" End If On Error GoTo 0 With WS If .Cells(1, USERNAME_COL).Value = vbNullString Then .Cells(1, USERNAME_COL).Value = "用户名" .Cells(1, COMPUTERNAME_COL).Value = "计算机名" .Cells(1, OPEN_TIME_COL).Value = "开启时间" .Cells(1, CLOSE_TIME_COL).Value = "关闭时间" .Cells(1, OPEN_WB_NAME_COL).Value = "打开的工作簿名称" .Cells(1, CLOSE_WB_NAME_COL).Value = "关闭的工作簿名称" 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 ' 让关闭时间为空. 在关闭时输入. .Cells(RowNum, CLOSE_TIME_COL).Value = vbNullString .Cells(RowNum, OPEN_WB_NAME_COL).Value = ThisWorkbook.FullName ' 让关闭名称为空. 在关闭时输入. .Cells(RowNum, CLOSE_WB_NAME_COL).Value = vbNullString .UsedRange.Columns.AutoFit End With Application.ScreenUpdating = TrueEnd 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("跟踪") 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 = TrueEnd Sub
' 返回字符串S中vbNullChar, Chr(0)左侧部分.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 IfEnd Function
