troubleshooting Question

Compatibility Part 2

Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.ScFlag for Zambia asked on
Microsoft Access
1 Comment1 Solution66 ViewsLast Modified:
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
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

Regards

Chris
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 1 Comment.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 1 Comment.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros