vba - Check Active Directory Group Membership Offline

233 Views Asked by At

Is there in vba the possibility to check an Active Directory group membership offline?

I have managed the online and offline user credential check (username, password).

Online = Layer 3 connection to company domain network (LAN or Wifi)
Offline = No physical network connection - no LAN, no Wifi

Public Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" _
(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, _
 ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const LOGON32_PROVIDER_DEFAULT As Long = 0&
Public Const LOGON32_LOGON_INTERACTIVE As Integer = 2&

Public Function ADUserLogin(ByVal strUsername As String, ByVal strPassword As String, _
                            ByVal strDomain As String) As Boolean

    On Error GoTo ADUserLogin_Error
    Dim tokenHandle As Long
 
    ADUserLogin = LogonUser(strUsername, strDomain, strPassword,  LOGON32_LOGON_INTERACTIVE, _
                            LOGON32_PROVIDER_DEFAULT, tokenHandle)
    CloseHandle tokenHandle
    
    On Error GoTo 0
    Exit Function

ADUserLogin_Error:

    MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure ADUserLogin, line " & Erl & "."
End Function

But how does it work for the Active Directory group membership?

With kind regards Ronny

1

There are 1 best solutions below

0
On BEST ANSWER

I have solved it as follows. When the user logs in online, I check which group he belongs to and save this including the last login date and time. Now the user has 14 days the possibility to log in offline to the database.

If in the meantime there is a connection to the domain again, I simply check the group membership again and react accordingly.

If someone knows a better way, I am always open for suggestions. :-)

Public Function IsMember(ByVal strUsername As String, ByVal strPassword As String, ByVal strGroup As String, Optional ByVal strDomain As String) As Boolean
10        On Error GoTo IsMember_Error

20        If Not Len(strDomain) <> 0 Or IsNull(strDomain) Then
30            strDomain = CreateObject("WScript.Network").UserDomain
40        End If

50        Set objIADS = GetObject("WinNT:").OpenDSObject("WinNT://" & strDomain, strUsername, strPassword, ADS_SECURE_AUTHENTICATION)
60        Set objIADSUser = objIADS.GetObject("user", strUsername)

70        For Each Member In objIADSUser.Groups
80            If Member.Class = "Group" Then
90                If Member.Name = strGroup Then
100                   IsMember = True
110                   SaveUserMembership strUsername, strGroup, strDomain, Date, Time
120                   Exit For
130               End If
140           End If
150       Next

160       On Error GoTo 0
170       Exit Function

IsMember_Error:

180       MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure IsMember, line " & Erl & "."
End Function