Modifications to VBScript, adding users to security group based on OU - My first post!
I've searched through hundreds of forums for days on end and FINALLY found this absolutely amazing script written by Matthew Beattie and it works perfectly. The one thing is, I want to have this script run every 6 hours and have the 2 prompts suppressed. You'll see that the last 15-20 lines of code are for 2 message boxes to appear. The first is when the process starts to let you know that it's actually started and the 2nd message box is to let you know that the process finished successfully.
I tried to comment out these lines of code and just run the script but it didn't work. I want to suppress these message boxes so i can have the script run every 6 hours or so and be completely automated. Any help is appreciated.
Thanks.
I tried to comment out these lines of code and just run the script but it didn't work. I want to suppress these message boxes so i can have the script run every 6 hours or so and be completely automated. Any help is appreciated.
Thanks.
'----------------------------------------------------------------------------------------------------------------------------
'Script Name : AddUsersToGroup.vbs
'Author : Matthew Beattie
'Created : 06/05/09
'Description : This script adds all users within an Organizational Unit to an Active Directory security group.
'----------------------------------------------------------------------------------------------------------------------------
'Initialization Section
'----------------------------------------------------------------------------------------------------------------------------
Option Explicit
Dim objDictionary, objFSO, scriptBaseName, scriptPath, scriptLogPath
On Error Resume Next
Set objDictionary = NewDictionary
Set objFSO = CreateObject("Scripting.FileSystemObject")
scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)
scriptPath = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
scriptLogPath = scriptPath & "\" & scriptBaseName
If Err.Number <> 0 Then
Wscript.Quit
End If
On Error Goto 0
'----------------------------------------------------------------------------------------------------------------------------
'Main Processing Section
'----------------------------------------------------------------------------------------------------------------------------
On Error Resume Next
ProcessScript
If Err.Number <> 0 Then
Wscript.Quit
End If
On Error Goto 0
'----------------------------------------------------------------------------------------------------------------------------
'Main Processing Section
'----------------------------------------------------------------------------------------------------------------------------
Function ProcessScript
Dim domainName, ouPath, groupName, ldapQuery
Dim userADsPaths, groupADsPaths, groupADsPath, group, i
PromptScriptStart
ouPath = "OU=ABC,OU=Users,OU=MyBusiness"
groupName = "ABC Security Group"
'-------------------------------------------------------------------------------------------------------------------------
'Get the distinguished Name of the domain.
'-------------------------------------------------------------------------------------------------------------------------
If Not GetDomainName("ldap", domainName) Then
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Perform an LDAP query to search for all user objects within the Organizational Unit specified by the "ouPath" variable.
'-------------------------------------------------------------------------------------------------------------------------
ldapQuery = "Select distinguishedName From 'LDAP://" & ouPath & "," & domainName & "' Where objectCategory = 'user'"
If Not GetADObjectsADsPaths(userADsPaths, ldapQuery) Then
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Perform an LDAP query to search for adsPath of the group to add all the users to.
'-------------------------------------------------------------------------------------------------------------------------
ldapQuery = "Select distinguishedName From 'LDAP://" & _
domainName & "' Where objectCategory = 'group' And sAMAccountName = '" & groupName & "'"
If Not GetADObjectsADsPaths(groupADsPaths, ldapQuery) Then
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Ensure that the value of the groupName variable matches the value in the array of groups returned from the ldap query.
'-------------------------------------------------------------------------------------------------------------------------
For i = 0 To UBound(groupADsPaths)
group = Replace(Split(groupADsPaths(i), ",OU=")(0), "LDAP://CN=", "")
If StrComp(group, groupName, vbTextCompare) = 0 Then
groupADsPath = groupADsPaths(i)
Exit For
End If
Next
'-------------------------------------------------------------------------------------------------------------------------
'Add the Array of Active Directory users to the security group.
'-------------------------------------------------------------------------------------------------------------------------
If Not AddGroupMembers(groupADsPath, userADsPaths) Then
Exit Function
End If
PromptScriptEnd
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : GetDomainName -> Gets the name of the domain based on the input parameter parsed to the function.
'Parameters : format -> Defines the naming format the function returns. This can be:
' : -> "dns" : = microsoft.com
' : -> "ldap" : = DC=microsoft,DC=com
' : -> "netbios" : = MICROSOFT
' : result -> Input/outup : The name of the domain in the input specified format.
'Return : GetDomainName -> Returns True and the Domain Name in the input format specified otherwise returns False.
'----------------------------------------------------------------------------------------------------------------------------
Function GetDomainName(format, result)
Const AdsNameInitTypeGC = 3
Const AdsNameTypeNT4 = 3
Const AdsNameType1779 = 1
GetDomainName = False
Dim domain, netbios
Dim objTranslate
On Error Resume Next
Set objTranslate = CreateObject("NameTranslate")
If Err.Number <> 0 Then
Exit Function
End If
domain = GetObject("LDAP://RootDSE").Get("DefaultNamingContext")
If Err.Number <> 0 Then
Exit Function
End If
On Error Goto 0
Select Case Lcase(format)
Case "ldap"
result = domain
Case "dns"
result = Mid(Replace(domain, ",DC=", "."), 4)
Case "netbios"
objTranslate.Init AdsNameInitTypeGC, ""
objTranslate.Set AdsNameType1779, domain 'GetDomainName("ldap")
netbios = Left(objTranslate.Get(AdsNameTypeNT4), Len(objTranslate.Get(AdsNameTypeNT4)) -1)
If Err.Number <> 0 Then
Exit Function
End If
result = netbios
End Select
GetDomainName = True
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : GetADObjectsADsPaths -> Searches Active Directory for the objects specified in the LDAP query and
' : -> returns and Array of the object adsPaths.
'Parameters : adsPaths -> Output: An array. Each element of the array contains the ADsPath of an Object found.
' : ldapQuery -> String contain the LDAP query to process.
'Return : GetADObjectsADsPaths -> Returns True and an Array containing the ADsPaths of the objects returned from the
' : -> LDAP Query otherwise returns False.
'----------------------------------------------------------------------------------------------------------------------------
Function GetADObjectsADsPaths(adsPaths, ldapQuery)
Dim objectDict, objConnection, objCommand, objRecordSet, objectADsPath
Const ADsScopeSubtree = 2
GetADObjectsADsPaths = False
Set objectDict = NewDictionary
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.Properties("Searchscope") = ADsScopeSubtree
objCommand.CommandText = ldapQuery
On Error Resume Next
Set objRecordSet = objCommand.Execute
If objRecordSet.BOF And objRecordSet.EOF Then
Exit Function
End If
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
objectADsPath = "LDAP://" & Replace(objRecordSet.Fields("distinguishedName").Value, "/", "\/")
objectDict(objectDict.Count) = objectADsPath
objRecordSet.MoveNext
Loop
If Err.Number <> 0 Then
Exit Function
End If
objConnection.Close
On Error Goto 0
adsPaths = objectDict.Items
GetADObjectsADsPaths = True
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : AddGroupMembers -> Adds an Array of Active Directory users to an Array of Active Directory Groups.
'Parameters : groupADsPaths -> An Array containing the ADsPath values of the groups to add each user to.
' : userADsPaths -> An Array containing the ADsPath values of users to add to each group.
'Return : AddGroupMembers -> Returns True if successfull otherwise returns False.
'----------------------------------------------------------------------------------------------------------------------------
Function AddGroupMembers(groupADsPaths, userADsPaths)
Dim objGroup, errorCount, i, j, userdn
Const adsPropertyAppend = 3
AddGroupMembers = False
errorCount = 0
If Not IsArray(groupADsPaths) Then
groupADsPaths = Array(groupADsPaths)
End If
If Not IsArray(userADsPaths) Then
userADsPaths = Array(userADsPaths)
End If
On Error Resume Next
For i = 0 To UBound(groupADsPaths)
Do
Set objGroup = GetObject(groupADsPaths(i))
If Err.Number <> 0 Then
errorCount = errorCount + 1
Exit Do
End If
For j = 0 To UBound(userADsPaths)
Do
objGroup.PutEx adsPropertyAppend, "member", Array(Replace(userADsPaths(j), "LDAP://", ""))
objGroup.SetInfo
If Err.Number <> 0 Then
errorCount = errorCount + 1
Exit Do
End If
Loop Until True
Next
Loop Until True
Next
On Error Goto 0
If errorCount <> 0 Then
Exit Function
End If
AddGroupMembers = True
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : NewDictionary -> Creates a new dictionary object.
'Parameters : None ->
'Return : NewDictionary -> Returns a dictionary object.
'----------------------------------------------------------------------------------------------------------------------------
Function NewDictionary
Dim dict
Set dict = CreateObject("scripting.Dictionary")
dict.CompareMode = vbTextCompare
Set NewDictionary = dict
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : DQ -> Place double quotes around a string and replace double quotes
' : -> within the string with pairs of double quotes.
'Parameters : stringValue -> String value to be double quoted
'Return : DQ -> Double quoted string.
'----------------------------------------------------------------------------------------------------------------------------
Function DQ (ByVal stringValue)
If stringValue <> "" Then
DQ = """" & Replace (stringValue, """", """""") & """"
Else
DQ = """"""
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : PromptScriptStart -> Prompt when script starts.
'Parameters : None
'Return : None
'----------------------------------------------------------------------------------------------------------------------------
'Function PromptScriptStart
' MsgBox "Now processing the " & DQ(Wscript.ScriptName) & " script.", vbInformation, scriptBaseName
'End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : PromptScriptEnd -> Prompt when script has completed.
'Parameters : None
'Return : None
'----------------------------------------------------------------------------------------------------------------------------
'Function PromptScriptEnd
' MsgBox "The " & DQ(Wscript.ScriptName) & " script has completed successfully.", vbInformation, scriptBaseName
'End Function
'----------------------------------------------------------------------------------------------------------------------------
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.