User Log File - on Opening Template File

[katwan69]

I have an Excel Macro Template file on our Network for our Sales Team to use. I want to record the user name and time/date in a seperate user log file hidden from the user, so I can keep track and frequency of the file being used. This would be VBA Code as an on open-event or after open in my file, but they are not opening the actual file but a copy of the file. The user log file is located on the Network drive named Access Log.

Can this be done in VBA, and how ?

Thanks in advance for any assistance.

 

[Logit]

.
You can place this code into the workbook they are accessing. Paste all of the code into the ThisWorkbook Module.

Create a sheet named Audit which can be hidden.

When the user opens the workbook the code will record their login name, their computer ID and the open date/time. It records
the close date/time as well.

The code is presently set to track 10 uses. You can change that number as needed.

Option Explicit


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  '<--- change this as needed


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
''''''''''''''''''''''''''''''''''''''''

 

[katwan69]

This great, should do the trick.

Just one thing, is that it writes to the file that is opened, hence, at the users end on a distributed network. I was wondering if I could get it to write to a specific log file where the original template is located using full specific address. Also I probably will not be using the on-close options for the same reason.

.
You can place this code into the workbook they are accessing. Paste all of the code into the ThisWorkbook Module.

Create a sheet named Audit which can be hidden.

When the user opens the workbook the code will record their login name, their computer ID and the open date/time. It records
the close date/time as well.

The code is presently set to track 10 uses. You can change that number as needed.

Thanking you for your assistance.