''''''''''''''''''''''''''''''''''''''''''
' WORKBOOK USAGE TRACKING
''''''''''''''''''''''''''''''''''''''''''
Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare PtrSafe 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 ELAPSE_TIME_COL = 7
Private Const KEEP_ONLY_LAST_N_ENTRIES = 10
Private Sub Workbook_Open()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_Open
' Runs when the workbook is opened.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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("Audit")
If Err.Number = 9 Then
Set WS = Sheets.Add(Before:=Sheets(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, ELAPSE_TIME_COL).Value = "Elapse 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)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Runs when the workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WS As Worksheet
Dim RowNum As Long
Dim EndRow As Long
Dim LastDel As Long
Dim FirstDel As Long
Dim sTime As Date
Dim eTime As Date
Dim strMin As String
Dim strSec As String
Application.ScreenUpdating = False
Set WS = Worksheets("Audit")
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
sTime = .Cells(RowNum, OPEN_TIME_COL)
eTime = .Cells(RowNum, CLOSE_TIME_COL)
strMin = DateDiff("n", sTime, eTime)
strSec = DateDiff("s", sTime, eTime) - strMin
.Cells(RowNum, ELAPSE_TIME_COL) = strMin & " min " & strSec & " sec"
End With
Application.ScreenUpdating = True
MsgBox "Elapse Time = " & WS.Cells(RowNum, ELAPSE_TIME_COL)
'ActiveWorkbook.Save
End Sub
Private Function TrimToNull(S As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''
' TrimToNull
' Returns the portion of string S that is to the
' left of the vbNullChar, Chr(0).
'''''''''''''''''''''''''''''''''''''''''''''''''''
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
''''''''''''''''''''''''''''''''''''''''''
' END CODE
''''''''''''''''''''''''''''''''''''''''''
