Tracking Workbook Opens And Closes

This page describes how to track workbook open and close operations.

Introduction

In some places, for audit and security requirements, you may wish to track when and by whom a workbook was opened and closed. While I am personally against such snooping by the boss, it does, occassionally have its place. You can implement such tracking with some event procedures in the ThisWorkbook module. The code shown below creates a log of the user name and computer name who opened the workbook, the time it was opened, the workbook's name when it was opened, the time it was closed, and the workbook's name upon closing. The workbook names are stored so that a Save As operation can be determined from the log. This information is kept in an xlVeryHidden worksheet named Audit. An additional option is to keep in the log only the N most recent audit records.

The structure of the audit log is kept controled by the following constants:

    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

The constants whose name ends in _COL are the column numbers in which each piece of information is to be stored. The constant KEEP_ONLY_LAST_N_ENTRIES indicates the number of most recent entries in the log to keep. Entries before these are deleted. To keep all entries, without deleting any, set the value of this constant to 0.

The Code

All of the code below should be placed in the ThisWorkbook module of the workbook.

''''''''''''''''''''''''''''''''''''''''''
' WORKBOOK USAGE TRACKING
''''''''''''''''''''''''''''''''''''''''''
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()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 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 = 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)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
    
    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
    End With
    
    Application.ScreenUpdating = True
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
''''''''''''''''''''''''''''''''''''''''''

This page last updated: 10-April-2010.