Logging script

[xSeraja]

Hi everyone,

I am trying to make a script which logs everytime someone opened and closed the excel file.
Right now, the script writes this in a worksheet, but I want it to overwrite the date and time, so everyones name appears only ones.
I am getting this output now:

Closed Seraja 21-10-2022 09:16
Closed Seraja 21-10-2022 09:16
Opened Seraja 21-10-2022 09:18
Closed Seraja 21-10-2022 09:27
Opened Seraja 21-10-2022 09:27

Does anyone know how I can do this?

I have the following code:

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

Function fOSUserName() As String
' Returns the network login name
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
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function

Function fOSMachineName() As String
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 255
strCompName = String$(lngLen - 1, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function

Sub auto_open()
Call DoTheLog(myKey:="Opened")
Sheets(1).Select
' Range("E4") = Range("E4")
End Sub
Sub auto_close()
Call DoTheLog(myKey:="Closed")
End Sub
Sub DoTheLog(myKey As String)
On Error GoTo 44
Sheets("Log").Select
Range("A1").Select
Do Until ActiveCell = Empty
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.FormulaR1C1 = myKey
ActiveCell.Offset(0, 1).FormulaR1C1 = Application.UserName
'ActiveCell.Offset(0, 2).FormulaR1C1 = fOSUserName
ActiveCell.Offset(0, 2).FormulaR1C1 = Date + Time 'Format(Now, "mmmm dd, yyyy hh:mm:ss")

If myKey = "Closed" Then
ActiveCell.Offset(0, 5).FormulaR1C1 = ActiveCell.Offset(0, 4) - ActiveCell.Offset(-1, 4)
End If
Sheets(1).Select

44 Open ThisWorkbook.Path & "" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & "_Usage.log" For Append As #1
Print #1, myKey & vbTab & Application.UserName _
& vbTab & fOSUserName _
& vbTab & fOSMachineName _
& vbTab & Format(Now, "mmmm dd, yyyy hh:mm:ss")
Close #1
End Sub

[dangelor]

Copy to the ThisWorkbook code module.

Please Login or Register  to view this content.