Excel/Word/Access user log
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 172.19.20.22
Original Author: uloncha
Inputs
UserId, IP (taken from registry), Time stamp.
Assumptions
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.
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
Code
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)
Else
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)
Else
WorkstationID = "?"
End If
End Function
Sub AUTO_Open()'put it in workbook_open in excel
ip = getstring(HKEY_LOCAL_MACHINE, "SystemCurrentControlSetServicesClassNetTrans
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.