VBA/Excel/Access/Word/Windows API/Windows User

Get computer name

 
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Private Function ComputerName() As String
    Dim stBuff As String * 255, lAPIResult As Long
    Dim lBuffLen As Long
    
    lBuffLen = 255
    lAPIResult = GetComputerName(stBuff, lBuffLen)
    If lBuffLen > 0 Then ComputerName = Left(stBuff, lBuffLen)
End Function
Sub ComputerCheck()
    Debug.Print ComputerName
End Sub

Retrieve USERID

 
Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
    Private Const NO_ERROR = 0
    Private Const ERROR_NOT_CONNECTED = 2250&
    Private Const ERROR_MORE_DATA = 234
    Private Const ERROR_NO_NETWORK = 1222&
    Private Const ERROR_EXTENDED_ERROR = 1208&
    Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
    
    Function WinUsername() As String
        Dim strBuf As String, lngUser As Long, strUn As String
        strBuf = Space$(255)
        lngUser = WNetGetUser("", strBuf, 255)
        If lngUser = NO_ERROR Then
            strUn = Left(strBuf, InStr(strBuf, vbNullChar) - 1)
            WinUsername = strUn
        Else
            WinUsername = "Error :" & lngUser
        End If
End Function
Sub CheckUserRights()
    Dim UserName As String
    UserName = WinUsername
    Select Case UserName
        Case "Administrator"
            MsgBox "Full Rights"
        Case "Guest"
            MsgBox "You cannot make changes"
        Case Else
            MsgBox "Limited Rights"
    End Select
End Sub