I produce quite a nmber of reports on a daily basis which takes up a vast amount of time on a morning. I'm working out the actual need for all the reports by monitoring who of the people that receive the reports is actually using them.

The code below is what I use to record who is going in and out of the reports.

Is there a way I can record the actual time that there were in the reports?

Public bEnableEvents As Boolean
Public bclickok As Boolean
Public booRestoreErrorChecking As Boolean   'put this at the top of the module

Private Declare Function apiGetComputerName Lib "kernel32" Alias _
    "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Sub LogIn()
'Login Capture
Dim intfile As Integer
Dim strFileName, LoginName As String
Dim Action As String, File As String, Path As String
On Error Resume Next
    Action = "USER LOGIN"
    Path = ActiveWorkbook.Path
    File = ActiveWorkbook.Name
    intfile = FreeFile()
    strFileName = "\\MyServer\Data\MonitorLogs\" & "\MonitorLogs.txt"
    LoginName = UCase(GetUserId)
    If LoginName = "Jez" Then
        Exit Sub
        Else
            Open strFileName For Append Shared As intfile
            Print #intfile, Now; "|"; Action; "|"; File; "|"; LoginName; "|"
            Close intfile
    End If
End Sub

Public Sub LogOut()
'Login Capture
Dim intfile As Integer
Dim strFileName, LoginName As String
Dim Action As String, File As String, Path As String
On Error Resume Next
    Action = "USER LOGOUT"
    Path = ActiveWorkbook.Path
    File = ActiveWorkbook.Name
    intfile = FreeFile()
    strFileName = "\\MyServer\Data\MonitorLogs\" & "\MonitorLogs.txt"
    LoginName = UCase(GetUserId)
    If LoginName = "Jez" Then
        Exit Sub
        Else
            Open strFileName For Append Shared As intfile
            Print #intfile, Now; "|"; Action; "|"; File; "|"; LoginName; "|"
            Close intfile
    End If
End Sub

Function GetMachineName() As String
'Returns the computername
On Error Resume Next
Dim lngLen As Long, lngX As Long
Dim strCompName As String
    lngLen = 16
    strCompName = String$(lngLen, 0)
    lngX = apiGetComputerName(strCompName, lngLen)
    If lngX <> 0 Then
        GetMachineName = Left$(strCompName, lngLen)
    Else
        GetMachineName = ""
    End If
End Function

Function GetUserId() As String
' Returns the network login name
On Error Resume Next
Dim lngLen As Long, lngX As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If lngX <> 0 Then
        GetUserId = Left$(strUserName, lngLen - 1)
    Else
        GetUserId = ""
    End If
    Exit Function
End Function

Private Sub Workbook_Open()
'Turn OFF background error checking for Excel 2003 if not turned on already
'Error checking is restored when the workbook is closed if that was the user's preference before opening the workbook
    If VBA.Val(Application.Version) >= 11 Then
        If Application.ErrorCheckingOptions.BackgroundChecking = True Then
            Application.ErrorCheckingOptions.BackgroundChecking = False
            booRestoreErrorChecking = True
        End If
    End If
    
    AddIns("Analysis ToolPak").Installed = True
    AddIns("Analysis ToolPak - VBA").Installed = True
    AddIns("Lookup Wizard").Installed = True
    Application.ScreenUpdating = False
    Call LogIn
End Sub

Private Sub Workbook_BeforeClose(cancel As Boolean)
'Turn ON background error checking for Excel 2003 if on before opening workbook
    If VBA.Val(Application.Version) >= 11 And booRestoreErrorChecking = True Then
        Application.ErrorCheckingOptions.BackgroundChecking = True
    End If    
    Application.ScreenUpdating = False
    Call LogOut
End Sub