Help with User Tracking

D

doodle

I need to track what users access what and when. To do this, I have
implemented the following:

**************************************************************************
1. A table named tblSys_TrackUser with the folling fields:

TrackDate (PK)
User (PK)
UserObject (PK)

**************************************************************************
2. A function in a mod that pulls the windows login:
Option Compare Database
Option Explicit

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (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 = vbNullString
End If
End Function

**************************************************************************
3. All of the main forms and reports I want to track activity in
contain this code on open:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo tagError
Dim strSQL As String
Dim myUser As String

DoCmd.SetWarnings False

DoCmd.Hourglass False

myUser = fOSUserName()

Select Case myUser
Case "ADraughn" ' developer
Exit Sub
Case "RDuffey" ' developer
Exit Sub
Case Else
strSQL = "Insert INTO tblSys_TrackUser(User,UserObject)" &
_
"Values ('" & myUser & "','" & Me.Name & "')"

DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

End Select

DoCmd.Restore

Exit Sub

tagError:
MsgBox Err.Description

End Sub

**************************************************************************
Everything works fine. The problem is that calling that function is
slowing down performance on my forms. Any suggestions?

-doodle
 
K

KillMeTwice

I need to track what users access what and when. To do this, I have
implemented the following:

**************************************************************************
1. A table named tblSys_TrackUser with the folling fields:

TrackDate (PK)
User (PK)
UserObject (PK)

**************************************************************************
2. A function in a mod that pulls the windows login:
Option Compare Database
Option Explicit

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (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 = vbNullString
End If
End Function

**************************************************************************
3. All of the main forms and reports I want to track activity in
contain this code on open:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo tagError
Dim strSQL As String
Dim myUser As String

DoCmd.SetWarnings False

DoCmd.Hourglass False

myUser = fOSUserName()

Select Case myUser
Case "ADraughn" ' developer
Exit Sub
Case "RDuffey" ' developer
Exit Sub
Case Else
strSQL = "Insert INTO tblSys_TrackUser(User,UserObject)" &
_
"Values ('" & myUser & "','" & Me.Name & "')"

DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

End Select

DoCmd.Restore

Exit Sub

tagError:
MsgBox Err.Description

End Sub

**************************************************************************
Everything works fine. The problem is that calling that function is
slowing down performance on my forms. Any suggestions?

-doodle

I use this one:
---------------------
Public Function FindNetUserName() As String

' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim Status As Integer
' For getting user information.
Dim lpName, lpUserName As String
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
Status = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If Status = NoError Then
' This line removes the null character. Strings in C are
null-
' terminated. Strings in Visual Basic are not null-
terminated.
' The null character must be removed from the C strings to
be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) -
1)
Else
' An error occurred.
lpUserName = ""
End
End If
FindNetUserName = lpUserName
End Function-
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top