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>