|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
Option Explicit Public Function SearchDistinguishedName(ByVal logonName, ByVal ADType, ByVal searchBy) Dim oRootDSE, oConnection, oCommand, oRecordSet Set oRootDSE = GetObject("LDAP://rootDSE") Set oConnection = CreateObject("ADODB.Connection") oConnection.Open "Provider=ADsDSOObject;" Set oCommand = CreateObject("ADODB.Command") oCommand.ActiveConnection = oConnection oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;(&(objectCategory=" & ADType &")(" & searchBy &"=" & LogonName & "));distinguishedName;subtree" Set oRecordSet = oCommand.Execute SearchDistinguishedName = oRecordSet.Fields("DistinguishedName") oConnection.Close Set oRecordSet = Nothing Set oCommand = Nothing Set oConnection = Nothing Set oRootDSE = Nothing End Function Public Function AddUserToADGroup(byval User, byval Group, byref Result) on error resume next dim strDNSDomain, objRootLDAP, foundUser, foundGroup, objUser, objGroup foundUser = SearchDistinguishedName(User, "User", "samAccountName") foundGroup = SearchDistinguishedName(Group, "Group", "Name") if IsEmpty(foundUser) then Result = "Chyba: Neexistujici uzivatel" elseif IsEmpty(foundGroup) then Result = "Chyba: Neexistujici skupina" end if if Result = "" then Set objRootLDAP = GetObject("LDAP://RootDSE") strDNSDomain = objRootLDAP.Get("DefaultNamingContext") Set objUser = GetObject("LDAP://"& foundUser) Set objGroup = GetObject("LDAP://"& foundGroup) objGroup.add(objUser.ADsPath) if Err.Number > 0 then Result = "Chyba: " & Err.Number & " " & Err.Description Err.Clear AddUserToADGroup = false else Result = nothing AddUserToADGroup = true End If end if if Result = "" then Result = "OK" end if End Function Dim Error AddUserToADGroup "strachotao", "Domain Admins", Error MsgBox Error |