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:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
|
strGroupsFile = "groups.txt"
strUsersFile = "users.txt"
strResultsFile = "Results.txt"
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
strOU = "CN=Users," & strDomain
strResponse = InputBox( _
"What group type do you want to create from " & strGropsFile & "?" & VbCrLf & _
"1) Domain Local Distribution" & VbCrLf & _
"2) Global Security" & VbCrLf & _
"3) Universal Distribution" & VbCrLf & _
"4) Universal Security" & VbCrLf & VbCrLf & _
"The groups will be created in" & VbCrLf & _
strOU, _
"Group Type", "1")
Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
Const ADS_PROPERTY_APPEND = 3
Set objOU = GetObject("LDAP://" & strOU)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Set objResults = objFSO.CreateTextFile(strResultsFile, True)
objResults.WriteLine "Creating Groups " & Now
Set objUsers = objFSO.OpenTextFile(strUsersFile, intForReading, False)
strAllDNs = ""
While Not objUsers.AtEndOfStream
strUserName = objUsers.ReadLine
strUserDN = ""
strUserDN = Get_LDAP_User_Properties("user", "samAccountName", strUserName, "distinguishedName")
If strUserDN <> "" Then
If strAllDNs = "" Then
strAllDNs = strUserDN
Else
strAllDNs = strAllDNs & "|" & strUserDN
End If
Else
objResults.WriteLine "Could not find " & strUserName & ". User will not be added to new groups."
End If
Wend
objUsers.Close
arrAllDNs = Split(strAllDNs, "|")
boolInvalidGroupType = False
Set objGroups = objFSO.OpenTextFile(strGroupsFile, intForReading, False)
While Not objGroups.AtEndOfStream
strGroupName = objGroups.ReadLine
Set objGroup = objOU.Create("Group", "cn=" & strGroupName)
objGroup.Put "sAMAccountName", strGroupName
Select Case strResponse
Case "1"
objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP
objResults.WriteLine "Creating Domain Local Distribution groups."
Case "2"
objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED
objResults.WriteLine "Creating Global Security groups."
Case "3"
objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP
objResults.WriteLine "Creating Universal Distribution groups."
Case "4"
objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED
objResults.WriteLine "Creating Universal Security groups."
Case Else
boolInvalidGroupType = True
End Select
If boolInvalidGroupType = False Then
On Error Resume Next
objGroup.SetInfo
If Err.Number <> 0 Then
'MsgBox strGroupName & " already exists."
objResults.WriteLine strGroupName & " already exists. Users have not been altered."
Err.Clear
On Error GoTo 0
Else
On Error GoTo 0
objGroup.PutEx ADS_PROPERTY_APPEND, "member", arrAllDNs
objGroup.SetInfo
objResults.WriteLine strGroupName & " created. Users added."
End If
Else
MsgBox "Invalid group type selected."
End If
Set objGroup = Nothing
Wend
objGroups.Close
Set objGroups = Nothing
objResults.Close
MsgBox "Done"
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
' This is a custom function that connects to the Active Directory, and returns the specific
' Active Directory attribute value, of a specific Object.
' strObjectType: usually "User" or "Computer"
' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
' It filters the results by the value of strObjectToGet
' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
' For example, if you are searching based on the user account name, strSearchField
' would be "samAccountName", and strObjectToGet would be that speicific account name,
' such as "jsmith". This equates to "WHERE 'samAccountName' = 'jsmith'"
' strCommaDelimProps: the field from the object to actually return. For example, if you wanted
' the home folder path, as defined by the AD, for a specific user, this would be
' "homeDirectory". If you want to return the ADsPath so that you can bind to that
' user and get your own parameters from them, then use "ADsPath" as a return string,
' then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
' Now we're checking if the user account passed may have a domain already specified,
' in which case we connect to that domain in AD, instead of the default one.
If InStr(strObjectToGet, "\") > 0 Then
arrGroupBits = Split(strObjectToGet, "\")
strDC = arrGroupBits(0)
strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
strObjectToGet = arrGroupBits(1)
Else
' Otherwise we just connect to the default domain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strBase = ""
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Filter on user objects.
'strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = strCommaDelimProps
arrProperties = Split(strCommaDelimProps, ",")
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
' Define the maximum records to return
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
strReturnVal = ""
Do Until adoRecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strReturnVal = "" Then
strReturnVal = adoRecordset.Fields(intCount).Value
Else
strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
End If
Next
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
Get_LDAP_User_Properties = strReturnVal
End Function
|
