VBcoders Guest

Don't have an account yet? Register

Forgot Password?

Excel/Word/Access user log

by uloncha (1 Submission)
Category: Microsoft Office Apps/VBA
Compatability: Visual Basic 3.0
Difficulty: Beginner
Date Added: Wed 3rd February 2021
Rating: (4 Votes)

It keeps a log (IP, TIME (local), NetworkUserName) of those that open the office document you put the code in.
Example: Peter 7/29/2001 11:27:12 AM Great to see who is opening your files.

UserId, IP (taken from registry), Time stamp.
Read side effects. IP is taken from registry so it is necessary to point to its key. I took some code from other programmer's cotributions, if you recognize the code please let me know and i will mention you.
Code Returns
Writes inputs in builtindocumentproperties.
Side Effects
if file is opened too oftenly and the log is not cleared, "comment" may become too big (i bet it will crash). Also, note that comments can be read by anyone and cleared too (unless document is write protected with password)
API Declarations
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1 ' Unicode
Public Const REG_DWORD = 4 ' 32-bit
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpsubkey As String, phkresult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpvaluename As String, ByVal lpreserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long

Rate Excel/Word/Access user log

Public Function getstring(hkey As Long, strpath As String, strvalue As String)
Dim keyhand, datatype, lResult, lDataBufSize As Long
Dim strBuf As String
Dim intZeroPos As Integer
 r = RegOpenKey(hkey, strpath, keyhand)
 lResult = RegQueryValueEx(keyhand, strvalue, 0&, lValueType, ByVal 0&, lDataBufSize)
 If lValueType = REG_SZ Then
 strBuf = String(lDataBufSize, " ")
 lResult = RegQueryValueEx(keyhand, strvalue, 0&, 0&, ByVal strBuf, lDataBufSize)
 If lResult = ERROR_SUCCESS Then
  intZeroPos = InStr(strBuf, Chr$(0))
  If intZeroPos > 0 Then
  getstring = Left$(strBuf, intZeroPos - 1)
  getstring = strBuf
  End If
 End If
 End If
End Function
Public Function NetworkUserName() As String
 Dim lpBuff As String * 25
 Dim retval As Long
 retval = GetUserName(lpBuff, 25)
 NetworkUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function
Public Function WorkstationID() As String
 Dim sBuffer As String * 255
 If GetComputerNameA(sBuffer, 255&) > 0 Then
 WorkstationID = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 WorkstationID = "?"
 End If
End Function
Sub AUTO_Open()'put it in workbook_open in excel
ip = getstring(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\NetTrans\0001", "ipaddress")
ActiveWorkbook.BuiltinDocumentProperties(5) = ActiveWorkbook.BuiltinDocumentProperties(5) + vbCr + NetworkUserName & " " & Now & " " & ip
End Sub

Download this snippet    Add to My Saved Code

Excel/Word/Access user log Comments

No comments have been posted about Excel/Word/Access user log. Why not be the first to post a comment about Excel/Word/Access user log.

Post your comment

0/1000 characters