This browser is no longer supported.
Upgrade to Microsoft Edge to take advantage of the latest features, security updates, and technical support.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
I have a data macro for an audit table which works great except for tracking the system user. In VBA I can use Eviron("UserName") but I need to do this via macro. Here is the macro:
If Updated("[Oasis_Barcode]") Then
Create a Record in Audit
Set Field
Name Audit.TableName
Value = “[Files]”
Set Field
Name Audit.RecordID
Value = [Files].[ID]
Set Field
Name Audit.ChangeBy
Value = ??? Cannot use Environ
Set Field
Name Audit.FieldName
Value = “[Oasis_Barcode]”
Set Field
Name Audit.OldValue
Value = [Old].[Oasis_Barcode]
Set Field
Name Audit.NewValue
Value = [Files].[Oasis_Barcode]
Set Field
Name Audit.ChangeDate
Value = Now()
End If
i have created a public function as a module:
Public Function MyEnviron(username As String) As String
MyEnviron = VBA.Environ(username)
End Function
but I am not that familiar with using functions and dont know how to call this into a macro - can anyone give me any pointers?
Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.
Hi Paula,
Try to invoke the VBA function directly within your Data Macro like so:
Value = MyEnviron("UserName")
Try using the Windows API GetUserName function by calling the GetUser function from the following module. I would advise using this in any case as environmental variables are relatively easy for a moderately knowledgeable user to hack, who could thus masquerade as another user:
' module basGetUser
Option Compare Database
Option Explicit
Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal _
lpBuffer As String, nSize As Long) As Long
Public Function GetUser() As String
Dim strBuffer As String
Dim lngSize As Long, lngRetVal As Long
lngSize = 199
strBuffer = String$(200, 0)
lngRetVal = GetUserName(strBuffer, lngSize)
GetUser = Left$(strBuffer, lngSize - 1)
End Function
Public Function GetFullName()
Const MESSAGETEXT = "The current user is not recorded in the Users table."
Dim strCriteria As String
Dim varFullName As Variant
strCriteria = "LoginName = """ & GetUser & """"
varFullName = DLookup("FullName", "Users", strCriteria)
If Not IsNull(varFullName) Then
GetFullName = varFullName
Else
MsgBox MESSAGETEXT, vbExclamation, "Warning"
End If
End Function
Public Function AddNewUser()
Const USERNAMEEXISTS = 3022
Dim strMessage As String
Dim strCriteria As String
Dim strLoginName As String
Dim strFullName As String
Dim strSQL As String
strLoginName = GetUser()
strCriteria = "LoginName = """ & strLoginName & """"
AddUserHere:
If IsNull(DLookup("LoginName", "Users", strCriteria)) Then
strFullName = InputBox("Enter new user's full name for use in this database:")
strSQL = "INSERT INTO Users(LoginName,FullName) " & _
"VALUES(""" & strLoginName & """,""" & strFullName & """)"
On Error Resume Next
CurrentDb.Execute strSQL, dbFailOnError
Select Case Err.Number
Case 0
'no error
Case USERNAMEEXISTS
' existing user name; inform user and prompt for new name
strMessage = "The name " & strFullName & " is already in use" & _
vbNewLine & vbNewLine & "Please enter another name"
MsgBox strMessage, vbExclamation, "Invalid Operation"
GoTo AddUserHere
Case Else
' unknown error; inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
End If
End Function
Success!
Sophia you genius! When I hit refresh it worked - so simple.
Thank you so much
After extensive testing, I can confirm that this should work if you are using the Data Macro on the After Update or After Insert DM events. It won't work on Before Change DM.