User Log File - on Opening Template File

katwan69

New Member
Joined
Nov 9, 2009
Messages
4
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.
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
.
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.

Code:
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
''''''''''''''''''''''''''''''''''''''''
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,524
Messages
6,114,117
Members
448,549
Latest member
brianhfield

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top