Compatibility Part 2

I'm currently using access 2016 which one of the compatibility code is suitable below:

#IF Win64 THEN
  Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal _
   lpBuffer As String, nSize As Long) As LongPtr
#Else
  Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal _
   lpBuffer As String, nSize As Long) As Long
#End If
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()

    Dim strCriteria As String
    Dim strLoginName As String
    Dim strFullName As String
    Dim strSQL As String
    
    strLoginName = GetUser()
    strCriteria = "LoginName = """ & strLoginName & """"
    
    If IsNull(DLookup("LoginName", "Users", strCriteria)) Then
        strFullName = InputBox("Enter new user's full name:")
        strSQL = "INSERT INTO Users(LoginName,FullName) " & _
            "VALUES(""" & strLoginName & """,""" & strFullName & """)"
    
        CurrentDb.Execute strSQL, dbFailOnError
    End If

End Function

Select allOpen in new window

Or

Option Explicit

#If VBA7 Then
'* My 64-bit declarations
Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
'* My 32-bit declarations
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If


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()

    Dim strCriteria As String
    Dim strLoginName As String
    Dim strFullName As String
    Dim strSQL As String
    
    strLoginName = GetUser()
    strCriteria = "LoginName = """ & strLoginName & """"
    
    If IsNull(DLookup("LoginName", "Users", strCriteria)) Then
        strFullName = InputBox("Enter new user's full name:")
        strSQL = "INSERT INTO Users(LoginName,FullName) " & _
            "VALUES(""" & strLoginName & """,""" & strFullName & """)"
    
        CurrentDb.Execute strSQL, dbFailOnError
    End If

End Function

Select allOpen in new window

Regards

Chris