IS Administrator

Answer:
The following code should work for you:

In a form, create Command1, and an array of 2 labels named Label1:

Private Sub Command1_Click()
   
   If Module1.CheckLocalAdmin() = True Then
      Me.Label1(0).Caption = " Is Local Admin"
   Else
      Me.Label1(0).Caption = " Is *NOT* Local Admin"
   End If

   If Module1.CheckPDCAdmin() = True Then
      Me.Label1(1).Caption = " Is PDC Admin"
   Else
      Me.Label1(1).Caption = " Is *NOT* PDC Admin"
   End If

End Sub

Option Explicit

' Used for error trapping
Private m_lngErrNum                    As Long
Private m_strErrDesc                   As String
Private m_strErrSource                 As String

' Win32 NetAPIs.
Private Declare Function NetUserGetGroups _
   Lib "netapi32.dll" _
   (Servername As Byte, _
    username As Byte, _
    ByVal level As Long, _
    Buffer As Long, _
    ByVal prefmaxlen As Long, _
    entriesread As Long, _
    totalentries As Long) As Long
Private Declare Function NetUserGetLocalGroups _
   Lib "netapi32.dll" _
   (Servername As Byte, _
    username As Byte, _
    ByVal level As Long, _
    ByVal flags As Long, _
    Buffer As Long, _
    ByVal prefmaxlen As Long, _
    entriesread As Long, _
    totalentries As Long) As Long
Private Declare Function NetApiBufferFree _
   Lib "netapi32" _
   (ByVal pBuffer As Long) As Long
Private Declare Function GetComputerNameW _
   Lib "kernel32" _
   (lpBuffer As Any, _
    nSize As Long) As Long
Private Declare Function NetGetDCName _
   Lib "netapi32.dll" _
   (Servername As Byte, _
    DomainName As Byte, _
    Buffer As Long) As Long
Private Declare Sub CopyMem _
   Lib "kernel32" Alias "RtlMoveMemory" _
   (pTo As Any, _
    uFrom As Any, _
    ByVal lSize As Long)
Private Declare Function lstrlenW _
   Lib "kernel32" _
   (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW _
   Lib "kernel32" _
   (lpString1 As Byte, _
    ByVal lpString2 As Long) As Long
Private Declare Function GetUserName _
   Lib "advapi32.dll" Alias "GetUserNameA" _
   (ByVal lpBuffer As String, _
    nSize As Long) As Long
  
' Specific known errors for API calls used
'     by this class
Private Const ERROR_ACCESS_DENIED      As Long = 5&
Private Const ERROR_INVALID_NAME       As Long = 123&
Private Const ERROR_MORE_DATA          As Long = 234&

Private Const NERR_BASE                As Long = 2100&
Private Const NERR_Success             As Long = 0&
Private Const NERR_GroupNotFound       As Long = NERR_BASE + 120&
Private Const NERR_UserNotFound        As Long = NERR_BASE + 121&
Private Const NERR_InvalidComputer     As Long = NERR_BASE + 251&
Private Const NERR_DCNotFound          As Long = NERR_BASE + 353&

Private Const LG_INCLUDE_INDIRECT      As Long = 1&
Private Const UNLEN                    As Long = 256&

' Private constants for this class
Private Const constComputerNameLen     As Long = 15&     ' Maximum computer name length
Private Const wbcErrNoGroupsFound      As Long = 9000 + vbObjectError
Private Const wbcErrCouldNotFindPDC    As Long = 9001 + vbObjectError

' Private member variables
Private m_strUserID                    As String

Public Enum enumSecurityGroupLevel
   NoSecurity = 0
   UserSecurity = 1
   AdminSecurity = 2
   SuperAdminSecurity = 3
End Enum

' This is the error source for this module
Private Const m_constErrSource         As String = "MyProject" & ".clsNetGroups"

' *******************************************************
' Inputs       : N/A
' Outputs      : Boolean: TRUE if a Local Admin, FALSE otherwise
' Description  : Determine if current user is a local admininstrator
' *******************************************************
Public Function CheckLocalAdmin() As Boolean
   Dim p_strPDCName     As String
   Dim p_strUserID      As String
   Dim p_vntRtn         As Variant
   Dim p_lngNumItems    As Long
   Dim p_lngLoop        As Long
   
   ' Default to not admin (ie, FALSE)
   CheckLocalAdmin = False
   
   ' Get the current user
   p_strUserID = GetCurrentUserID()
   
   ' Get the groups this user belongs to
   p_vntRtn = GetNTUserLocalGroups(p_strUserID)
   
   ' Get the upper bounds of the group variant array
   On Error Resume Next
   p_lngNumItems = UBound(p_vntRtn)
   If Err.Number <> 0 Then
      Exit Function
   End If
   On Error GoTo 0
   
   ' Check for Administrator rights
   For p_lngLoop = 0 To p_lngNumItems
      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "ADMINISTRATORS" Then
         CheckLocalAdmin = True
      End If
   Next p_lngLoop
   
End Function

' *******************************************************
' Inputs       : N/A
' Outputs      : Boolean: TRUE if a Domain Admin, FALSE otherwise
' Description  : Determine if current user is a domain admin
' *******************************************************
Public Function CheckPDCAdmin() As Boolean
   Dim p_strPDCName     As String
   Dim p_strUserID      As String
   Dim p_vntRtn         As Variant
   Dim p_lngNumItems    As Long
   Dim p_lngLoop        As Long
   
   ' Default to not admin (ie, FALSE)
   CheckPDCAdmin = False
   
   ' Get the PDC name
   p_strPDCName = GetPDC("", "")
   
   ' Get the current user
   p_strUserID = GetCurrentUserID()
   
   ' Get the groups this user belongs to
   p_vntRtn = GetNTUserGlobalGroups(p_strUserID, p_strPDCName)
   
   ' Get the upper bounds of the group variant array
   On Error Resume Next
   p_lngNumItems = UBound(p_vntRtn)
   If Err.Number <> 0 Then
      Exit Function
   End If
   On Error GoTo 0
   
   ' Check for Administrator rights
   For p_lngLoop = 0 To p_lngNumItems
      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "DOMAIN ADMINS" Then
         CheckPDCAdmin = True
      End If
   Next p_lngLoop
   
End Function

' *******************************************************
' Inputs       : N/A
' Outputs      : String: The UserID of the current logged-on user
' Description  : Return the UserID of the current user
'              :     that has logged onto NT
' *******************************************************
Private Function GetCurrentUserID() As String
On Error Resume Next                   ' Don't accept errors here
   Const p_constProcName               As String = "GetNTUserLocalGroups"
   Dim p_strName                       As String
   Dim p_lngNameLen                    As Long
   
   ' Assume failure
   GetCurrentUserID = ""

   p_lngNameLen = UNLEN + 1
   p_strName = String$(p_lngNameLen, Chr$(0))
   If GetUserName(p_strName, p_lngNameLen) <> 0 Then
      GetCurrentUserID = Mid$(p_strName, 1, p_lngNameLen - 1)
   End If

On Error GoTo 0
End Function

' *******************************************************
' Inputs       : ByVal xi_strUserID:String   - UserID of current user
' Outputs      : Variant: Array of NT group names
' Description  : Pass in a userID and PDC, return a variant array
'              :     of groups that this user belongs to
' *******************************************************
Private Function GetNTUserLocalGroups(ByVal xi_strUserID As String) As Variant
On Error Resume Next                   ' Don't accept errors here
   Const p_constProcName               As String = "GetNTUserLocalGroups"
   Dim p_bytUserName()                 As Byte
   Dim p_bytServerName()               As Byte
   Dim p_astrGroups()                  As String
   Dim p_alngGroups()                  As Long
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBuffer                     As Long
   Dim p_lngEntriesRead                As Long
   Dim p_lngEntriesTotal               As Long
   Dim p_lngLevel                      As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_lngLoop                       As Long
   Dim p_lngFlags                      As Long
   
   ' Convert the user name to a byte array
   p_bytUserName = xi_strUserID & vbNullChar
   
   ' Convert the PDC name to a byte array
   p_bytServerName = vbNullChar & vbNullChar
   
   ' Get the groups
   p_lngLevel = 0&
   p_lngBufferPtr = 4096
   p_lngFlags = LG_INCLUDE_INDIRECT
   p_lngRtn = NetUserGetLocalGroups(p_bytServerName(0), _
                                    p_bytUserName(0), _
                                    p_lngLevel, _
                                    p_lngFlags, _
                                    p_lngBuffer, _
                                    p_lngBufferPtr, _
                                    p_lngEntriesRead, _
                                    p_lngEntriesTotal)
      
   ' Check for errors
   If p_lngRtn = NERR_Success Then
      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long
      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String
      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4
      For p_lngLoop = 0 To p_lngEntriesRead - 1
         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))
      Next p_lngLoop
   Else
      ' Do your own error handling here
      m_lngErrNum = wbcErrNoGroupsFound
      
      Select Case p_lngRtn
         Case ERROR_ACCESS_DENIED
            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."
         Case NERR_UserNotFound
            p_strTmp = "User not found: " & xi_strUserID
         Case Else
            p_strTmp = "Unknown error: " & CStr(p_lngRtn)
      End Select
   End If
   
   ' ------------------------------------------
   ' Free the buffer
   ' ------------------------------------------
   If p_lngBuffer Then
      NetApiBufferFree p_lngBuffer
   End If
   
   ' ------------------------------------------
   ' Set the return value
   ' ------------------------------------------
   GetNTUserLocalGroups = p_astrGroups
   
On Error GoTo 0
End Function

' *******************************************************
' Inputs       : ByVal xi_strUserID:String   - UserID of current user
'              : ByVal xi_strPDCName:String  - PDC of domain (can be blank)
' Outputs      : Variant: Array of NT group names
' Description  : Pass in a userID and PDC, return a variant array
'              :     of groups that this user belongs to
' *******************************************************
Private Function GetNTUserGlobalGroups(ByVal xi_strUserID As String, _
                                       ByVal xi_strPDCName As String) As Variant
On Error Resume Next                   ' Don't accept errors here
   Const p_constProcName               As String = "GetNTUserGlobalGroups"
   Dim p_bytUserName()                 As Byte
   Dim p_bytServerName()               As Byte
   Dim p_astrGroups()                  As String
   Dim p_alngGroups()                  As Long
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBuffer                     As Long
   Dim p_lngEntriesRead                As Long
   Dim p_lngEntriesTotal               As Long
   Dim p_lngLevel                      As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_lngLoop                       As Long
   
   ' Convert the user name to a byte array
   p_bytUserName = xi_strUserID & vbNullChar
   
   ' Convert the PDC name to a byte array
   If Len(Trim$(xi_strPDCName)) = 0 Then
      p_bytServerName = vbNullChar
   Else
      If InStr(xi_strPDCName, "\\") = 1 Then
         p_bytServerName = xi_strPDCName & vbNullChar
      Else
         p_bytServerName = "\\" & xi_strPDCName & vbNullChar
      End If
   End If
   
   ' Get the groups
   p_lngLevel = 0&
   p_lngBufferPtr = 4096
   p_lngRtn = NetUserGetGroups(p_bytServerName(0), _
                               p_bytUserName(0), _
                               p_lngLevel, _
                               p_lngBuffer, _
                               p_lngBufferPtr, _
                               p_lngEntriesRead, _
                               p_lngEntriesTotal)
      
   ' Check for errors
   If p_lngRtn = NERR_Success Then
      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long
      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String
      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4
      For p_lngLoop = 0 To p_lngEntriesRead - 1
         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))
      Next p_lngLoop
   Else
      ' Do your own error handling here
      m_lngErrNum = wbcErrNoGroupsFound
      
      Select Case p_lngRtn
         Case ERROR_ACCESS_DENIED
            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."
         Case NERR_InvalidComputer
            p_strTmp = "Invalid computer name for PDC: " & xi_strPDCName
         Case NERR_UserNotFound
            p_strTmp = "User not found: " & xi_strUserID
         Case Else
            p_strTmp = "Unknown error: " & CStr(p_lngRtn)
      End Select
   End If
   
   ' Free the buffer
   If p_lngBuffer Then
      NetApiBufferFree p_lngBuffer
   End If
   
   ' Set the return value
   GetNTUserGlobalGroups = p_astrGroups
   
On Error GoTo 0
End Function

' *******************************************************
' Inputs       : ByVal xi_strServer:String   -- Name of server
'              : ByVal xi_strDomain:String   -- Name of the domain
'              : ByRef xo_strPDC_Name:String -- output, name of PDC
' Outputs      : Long: Zero if successful, non-zero otherwise
' Description  : Get the PDC of the current machine
' *******************************************************
Private Function GetPDC(ByVal xi_strServer As String, _
                        ByVal xi_strDomain As String) As String
On Error Resume Next                   ' Don't accept error here
   Const p_constProcName               As String = "GetPDC"
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_astrTmp(100)                  As Byte
   Dim p_abytServerName()              As Byte
   Dim p_abytDomainName()              As Byte
    
   ' Move to byte array
   p_abytServerName = xi_strServer & vbNullChar
   p_abytDomainName = xi_strDomain & vbNullChar
            
   ' Get the name of the PDC
   p_lngRtn = NetGetDCName(p_abytServerName(0), _
                           p_abytDomainName(0), _
                           p_lngBufferPtr)
   
   ' Set the return value (zero is success)
   If p_lngRtn = 0 Then
      GetPDC = True
   Else
      GetPDC = False
   
      ' Do your own error handling here
      m_lngErrNum = wbcErrCouldNotFindPDC
      Select Case p_lngRtn
         Case NERR_DCNotFound
            p_strTmp = "Could not find the domain controller for the current domain."
         Case ERROR_INVALID_NAME
            p_strTmp = "Invalid name for PDC -- the name could not be found."
         Case Else
            p_strTmp = "Unknown error: " & CStr(p_lngRtn)
      End Select
      m_strErrDesc = p_strTmp
      m_strErrSource = m_constErrSource & "." & p_constProcName
      
      On Error GoTo 0
      Err.Raise m_lngErrNum, m_strErrSource, m_strErrDesc
   End If
     
   ' Translate the name
   If p_lngRtn = 0 Then
      GetPDC = PointerToStringW(p_lngBufferPtr)
   Else
      GetPDC = ""
   End If
   
   ' Free the buffer
   NetApiBufferFree p_lngBufferPtr

On Error GoTo 0
End Function

' *******************************************************
' Inputs       : ByVal xi_lngStrPtr:Long  -- Pointer to a string
' Outputs      : String: Translated string
' Description  : When passed a pointer to a string,
'              :     return that string
' *******************************************************
Private Function PointerToStringW(ByVal xi_lngStrPtr As Long) As String
On Error Resume Next                   ' Don't accept error here
   Dim p_abytBuffer()                  As Byte
   Dim p_lngLength                     As Long
   
   If xi_lngStrPtr Then
      
      p_lngLength = lstrlenW(xi_lngStrPtr) * 2
      
      If p_lngLength Then
         ReDim p_abytBuffer(0 To (p_lngLength - 1)) As Byte
         CopyMem p_abytBuffer(0), ByVal xi_lngStrPtr, p_lngLength
         PointerToStringW = p_abytBuffer
      End If
   
   End If
   
On Error GoTo 0
End Function