Zablokovßnφ a odblokovßnφ u₧ivatelskΘho ·Φtu

Private Function EnableDisableUserAccount(UserName As String, _
Enable As Boolean) As Boolean

   'PARAMETRY : UserName=P°ihlaÜovacφ jmΘno u₧ivatele
   'Enable: True pro odblokovßnφ, False pro zablokovßnφ
   'V p°φpad∞ ·sp∞chu vracφ True, jinak False (nap°. u₧ivatel nenalezen)

   'POÄADAVKY : ADSI, LDAP provider,
   'referenci na Active DS Type Library,
   'U₧ivatel musφ mφt pot°ebnß prßva pro prßci s ·Φty

   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim oRoot As IADs
   Dim oDomain As IADs
   Dim sBase As String
   Dim sFilter As String
   Dim sDomain As String

   Dim sAttribs As String
   Dim sDepth As String
   Dim sQuery As String

   Dim oUser As IADsUser

   On Error GoTo errhandler

   Set oRoot = GetObject("LDAP://rootDSE")
   sDomain = oRoot.Get("defaultNamingContext")
   Set oDomain = GetObject("LDAP://" & sDomain)
   sBase = "<" & oDomain.ADsPath & ">"

   sFilter = "(&(objectCategory=person)(objectClass=user)(name=" _
   & UserName & "))"
   sAttribs = "adsPath"
   sDepth = "subTree"

   sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

   conn.Open _
   "Data Source=Active Directory Provider;Provider=ADsDSOObject"

   Set rs = conn.Execute(sQuery)

   With rs
      If Not .EOF Then
         Set oUser = GetObject(rs("adsPath"))
         oUser.AccountDisabled = Not Enable
         oUser.SetInfo
         EnableDisableUserAccount = True
      End If
   End With

errhandler:
   On Error Resume Next
   If Not rs Is Nothing Then
      If rs.State <> 0 Then rs.Close
      Set rs = Nothing
   End If

   If Not conn Is Nothing Then
      If conn.State <> 0 Then conn.Close
      Set conn = Nothing
   End If

   Set oRoot = Nothing
   Set oDomain = Nothing
   Set oUser = Nothing

End Function

P°φklad volßnφ:
EnableDisableUserAccount "Bozena", False

Zp∞t