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

Get computer name

   <source lang="vb">

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

</source>
   
  

Retrieve USERID

   <source lang="vb">

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

</source>