chandru_sol
asked on
Vbscript for adding users to Distribution groups
Hi,
Can you help me with a vbscript for adding users to distrbution groups from a csv file with samaccont name of the users and the group name they belong to in AD?
Error logging is required if the users is not found in the AD?
regards
Chandru
Can you help me with a vbscript for adding users to distrbution groups from a csv file with samaccont name of the users and the group name they belong to in AD?
Error logging is required if the users is not found in the AD?
regards
Chandru
Please post a sample line from your CSV file.
ASKER
Csv file will be of the format as below
Groupname,usersamaccountna me
regards
Chandru
Groupname,usersamaccountna
regards
Chandru
Hi chandru. This code should create the groups for you.
The only real change you'll need to make is to this line:
strOU = "OU=Users,OU=TestOU,"
to specify an OU to create your groups in.
Regards,
Rob.
The only real change you'll need to make is to this line:
strOU = "OU=Users,OU=TestOU,"
to specify an OU to create your groups in.
Regards,
Rob.
'Sample INPUT
'Grpname,samAccountName
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strLogFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "CreatedGroup.log"
strCSVFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "GroupsToCreate.csv"
strOU = "OU=Users,OU=TestOU,"
If strOU <> "" Then
If Right(strOU, 1) <> "," Then strOU = strOU & ","
End If
Set objRootDSE = GetObject("LDAP://RootDSE")
strLDAPPath = "LDAP://" & strOU & objRootDSE.Get("defaultNamingContext")
strResults = "Creating groups in " & strLDapPath & " from " & strCSVFile
strResults = strResults & VbCrLf & "Script started: " & Now
strResults = strResults & VbCrLf & "===============================" & VbCrLf
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = CreateObject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
strUser = strInput(1)
strGroupADsPath = Get_LDAP_User_Properties("group", "samAccountName", strGrpName, "adsPath")
boolValid = True
If InStr(strGroupADsPath, "LDAP://") = 0 Then
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strGrpName
objGroup.SetInfo
strResults = strResults & VbCrLf & strGrpName & " created."
ElseIf LCase(strGroupADsPath) <> LCase("LDAP://cn=" & strGrpName & "," & objOU.distinguishedName) Then
strResults = strResults & VbCrLf & "Another group exists with a samAccountName of " & strGrpName & VbCrLf & strGroupADsPath & VbCrLf & "LDAP://cn=" & strGrpName & "," & objOU.distinguishedName
boolValid = False
Else
strResults = strResults & VbCrLf & strGrpName & " already exists."
Set objGroup = GetObject(strGroupADsPath)
End If
If boolValid = True Then
strUserADsPath = Get_LDAP_User_Properties("user", "samAccountName", strUser, "adsPath")
If InStr(strUserADsPath, "LDAP://") > 0 Then
On Error Resume Next
objGroup.Add strUserADsPath
If Err.Number <> 0 Then
Err.Clear
strResults = strResults & VbCrLf & strUser & " is already a member of " & strGrpName
Else
strResults = strResults & VbCrLf & strUser & " was added to " & strGrpName
End If
On Error GoTo 0
Else
strResults = strResults & VbCrLf & "Unable to find " & strUser
End If
End If
Loop
strResults = strResults & VbCrLf & "===========================" & VbCrLf & "Script finished: " & Now
Set objLog = ObjFSO.CreateTextFile(strLogFile, True)
objLog.Write strResults
objLog.Close
Set objLog = Nothing
MsgBox "Script finished. Please see " & strLogFile
'Script End
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 = "<LDAP://" & strDNSDomain & ">"
' 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
ASKER
Hi Rob,
I have already a script to create the groups. Can the above script help add the users to the groups in the csv file
regards
Chandru
I have already a script to create the groups. Can the above script help add the users to the groups in the csv file
regards
Chandru
Yes. If you have the CSV file the way you mentioned, it will check if the group exists in the OU specified by strOU, and if not, creates it, otherwise it just adds the member, and logs this to the file as well.
Regards,
Rob.
Regards,
Rob.
ASKER
Thanks Rob!!
I will check now and get back to you on this. Can you help me with a HTA with two buttons to run the script on click and some info next to the buttons
regards
Chandru
I will check now and get back to you on this. Can you help me with a HTA with two buttons to run the script on click and some info next to the buttons
regards
Chandru
What kind of info? What function would the second button have? Can you explain a bit more what you want on the HTA?
Rob.
Rob.
ASKER
HTA as below
Picture Header
Button1 Notes1
Button2 Notes2
regards
Chandru
Picture Header
Button1 Notes1
Button2 Notes2
regards
Chandru
You are not providing enough information to create a HTA.
What is notes1 equal to in AD, what is notes2 equal to in AD, what is the purpose of button1 and button2?
What is the purpose of the HTA, what end results are you trying to get and what is the users starting point?
What is notes1 equal to in AD, what is notes2 equal to in AD, what is the purpose of button1 and button2?
What is the purpose of the HTA, what end results are you trying to get and what is the users starting point?
ASKER
Hi,
I want to assign vbscript to each button and the notes part will have information like check if the csv file has all the information
regards
chandru
I want to assign vbscript to each button and the notes part will have information like check if the csv file has all the information
regards
chandru
Even though you may think the end result is simple and you can see it in your head, I am not able this vision yet.
Hopefully you can help by taking about 15 minutes to sit down and write out your thoughts on this HTA. It seems apparent that you have already thought about the GUI, we now need to link this with some business logic. Your homework is this;
What is the file/input to be compared to what does a perfect list look like?
What rules do you want to enact when something counter to the above question is found?
What output is necessary for you to see that something in the input file is wrong? Do you need to see the line, the line number, the reason why?
It seems to me that button1 is supposed to import the file and process it according the above answers, is this correct?
For button2, am I to assume that this would start the processing of the input and log the results to the notes2 box?
Was the script to jump over lines that did not meet the criteria from above or was it to process everything and report on the results?
If you want the script to process everything, what was the purpose of button1 and showing lines that are not correct?
These are just a few question I came up with, please add as much detail as you can in order for us to help.
My suggestion is that you open a new question with the above information at the ready. I recommend this because the actual question you asked looks as though it has been answered and what you are now doing is requesting changes that are beyond the scope of the initial question.
Hopefully you can help by taking about 15 minutes to sit down and write out your thoughts on this HTA. It seems apparent that you have already thought about the GUI, we now need to link this with some business logic. Your homework is this;
What is the file/input to be compared to what does a perfect list look like?
What rules do you want to enact when something counter to the above question is found?
What output is necessary for you to see that something in the input file is wrong? Do you need to see the line, the line number, the reason why?
It seems to me that button1 is supposed to import the file and process it according the above answers, is this correct?
For button2, am I to assume that this would start the processing of the input and log the results to the notes2 box?
Was the script to jump over lines that did not meet the criteria from above or was it to process everything and report on the results?
If you want the script to process everything, what was the purpose of button1 and showing lines that are not correct?
These are just a few question I came up with, please add as much detail as you can in order for us to help.
My suggestion is that you open a new question with the above information at the ready. I recommend this because the actual question you asked looks as though it has been answered and what you are now doing is requesting changes that are beyond the scope of the initial question.
Thanks for the assistance rejoinder. I like the work you've done on other posts....pretty impressive...
Chandru, unfortunately we do need more information. HTA's aren't very easy to write in terms of making them easily customisable, so we kind of have to get it right the first time....
Have you tried the VBS version? It should fulfill the requirements for this question.
Regards,
Rob.
Chandru, unfortunately we do need more information. HTA's aren't very easy to write in terms of making them easily customisable, so we kind of have to get it right the first time....
Have you tried the VBS version? It should fulfill the requirements for this question.
Regards,
Rob.
ASKER
Thanks Rob and Rejoineder!!
Rob,
I would like to have the two vbscripts with some user interface
regards
Chandru
Rob,
I would like to have the two vbscripts with some user interface
regards
Chandru
So, the two scripts, are they this one, and the VBS code from comment ID: 22809117 on
https://www.experts-exchange.com/questions/23819287/vbscript-for-distribution-groups.html
We can have a button to run each of these. Can you explain what the two notes boxes will be for? Are you going to type information into those?
Regards,
Rob.
https://www.experts-exchange.com/questions/23819287/vbscript-for-distribution-groups.html
We can have a button to run each of these. Can you explain what the two notes boxes will be for? Are you going to type information into those?
Regards,
Rob.
ASKER
Yes those are the two scripts and notes button will have some information regarding the csv file
regards
Chandru
regards
Chandru
ASKER
Hi Rob,
Did you get a chance to work on this HTA?
regards
Chandru
Did you get a chance to work on this HTA?
regards
Chandru
It's very difficult for me to understand what you're after, but try this.
You'll need to change
strRequiredDomain = "YOURDOMAIN"
strPSExecPath = "\\server\share\psexec.exe "
Regards,
Rob.
You'll need to change
strRequiredDomain = "YOURDOMAIN"
strPSExecPath = "\\server\share\psexec.exe
Regards,
Rob.
<Html>
<Head>
<Title>Create Universal Distribution Group</Title>
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
<script Language = VBScript>
Dim strHTAPath
Sub Window_OnLoad
intWidth = 800
intHeight = 600
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
'Check if this HTA is running under the correct account
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strCurrentDomain = wshNetwork.UserDomain
strCurrentUser = wshNetwork.UserName
strRequiredDomain = "YOURDOMAIN"
strRequiredUser = "Administrator"
If Mid(document.location, 6, 3) = "///" Then
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
Else
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
strRequiredPassword = InputBox("This program is not running under the user account of " & strRequiredDomain & "\" & strRequiredUser & "." & VbCrLf &_
"Please enter the password for the required account, and the program will be restarted:", "Incorrect User")
If Trim(strRequiredPassword) <> "" Then
strPSExecPath = "\\server\share\psexec.exe"
strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & strRequiredDomain & "\" & strRequiredUser & " -p " & strRequiredPassword & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
'InputBox "Prompt", "Title", strCommand
Set objShell = CreateObject("WScript.Shell")
objShell.Run strCommand, 0, False
End If
Window.Close
End If
Set objRootDSE = GetObject("LDAP://RootDSE")
strBaseConnString = objRootDSE.Get("defaultNamingContext")
Set objOULevel = GetObject("LDAP://" & strBaseConnString)
RecurseOUs objOULevel, 0, strBaseConnString
Show_Selection
End Sub
Sub RecurseOUs(objOU, intLevel, strBaseConn)
Dim objOUObject, strConnString, objActiveOption
For Each objOUObject In objOU
If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
strConnString = objOUObject.DistinguishedName
Set objActiveOption = Document.CreateElement("OPTION")
If intLevel = 0 Then
objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
Else
objActiveOption.Text = String(intLevel * 4, " ") & "-> " & Replace(objOUObject.Name, "OU=", "")
End If
objActiveOption.Value = strConnString
lst_SiteFilter.Add objActiveOption
RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
End If
Next
End Sub
Sub Show_Selection
span_SiteFilter.InnerHTML = lst_SiteFilter.Value
End Sub
Sub Exit_HTA
Window.Close
End Sub
Sub Get_Groups_and_Manager_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_manager.Value = objDialog.FileName
End Sub
Sub Get_Groups_and_Users_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_users.Value = objDialog.FileName
End Sub
Sub Create_Groups_And_Manager
If Trim(txt_groups_and_manager.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_manager.Focus
Else
'Sample INPUT
'Grpname,This is a test grp,Ownername
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strCSVFile = txt_groups_and_manager.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = createobject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strInput(0)
objGroup.SetInfo
objGroup.description = strInput(1)
objGroup.SetInfo
'objGroup.MailEnable
'objGroup.SetInfo
Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM 'LDAP://" & objRootDSE.get("defaultNamingContext") & "' WHERE objectCategory='User' " & "AND CN='" & strInput(2) & "'"
Set objRecordSet2 = objCommand2.Execute
'wscript.echo objRecordSet2.Fields("Adspath").Value
If Not objRecordSet2.EOF then
objGroup.Put "managedby" , Trim(Replace(objRecordSet2.Fields("adspath").Value,"LDAP://"," "))
objGroup.SetInfo
Set objSD = objGroup.Get("ntSecurityDescriptor")
Set objDACL = objSD.DiscretionaryAcl
Set objACE = CreateObject("AccessControlEntry")
objACE.Trustee = objRecordSet2.Fields("UserprincipalName").Value
objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
objACE.AceFlags = 0
objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
objACE.ObjectType = MEMBER_ATTRIBUTE
objDACL.AddAce objACE
objSD.DiscretionaryAcl = objDACL
objGroup.Put "ntSecurityDescriptor", objSD
objGroup.SetInfo
End If
Loop
MsgBox "Groups have been created."
End If
End Sub
Sub Create_Groups_And_Users
If Trim(txt_groups_and_users.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_users.Focus
Else
'Sample INPUT
'Grpname,samAccountName
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strLogFile = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "CreatedGroups.log"
strCSVFile = txt_groups_and_users.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
strResults = "Creating groups in " & strLDapPath & " from " & strCSVFile
strResults = strResults & VbCrLf & "Script started: " & Now
strResults = strResults & VbCrLf & "===============================" & VbCrLf
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = CreateObject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
strUser = strInput(1)
strGroupADsPath = Get_LDAP_User_Properties("group", "samAccountName", strGrpName, "adsPath")
boolValid = True
If InStr(strGroupADsPath, "LDAP://") = 0 Then
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strGrpName
objGroup.SetInfo
strResults = strResults & VbCrLf & strGrpName & " created."
ElseIf LCase(strGroupADsPath) <> LCase("LDAP://cn=" & strGrpName & "," & objOU.distinguishedName) Then
strResults = strResults & VbCrLf & "Another group exists with a samAccountName of " & strGrpName & VbCrLf & strGroupADsPath & VbCrLf & "LDAP://cn=" & strGrpName & "," & objOU.distinguishedName
boolValid = False
Else
strResults = strResults & VbCrLf & strGrpName & " already exists."
Set objGroup = GetObject(strGroupADsPath)
End If
If boolValid = True Then
strUserADsPath = Get_LDAP_User_Properties("user", "samAccountName", strUser, "adsPath")
If InStr(strUserADsPath, "LDAP://") > 0 Then
On Error Resume Next
objGroup.Add strUserADsPath
If Err.Number <> 0 Then
Err.Clear
strResults = strResults & VbCrLf & strUser & " is already a member of " & strGrpName
Else
strResults = strResults & VbCrLf & strUser & " was added to " & strGrpName
End If
On Error GoTo 0
Else
strResults = strResults & VbCrLf & "Unable to find " & strUser
End If
End If
Loop
strResults = strResults & VbCrLf & "===========================" & VbCrLf & "Script finished: " & Now
Set objLog = ObjFSO.CreateTextFile(strLogFile, True)
objLog.Write strResults
objLog.Close
Set objLog = Nothing
MsgBox "Script finished. Please see " & strLogFile
End If
End Sub
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 = "<LDAP://" & strDNSDomain & ">"
' 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
</script>
<body style="background-color:#B0C4DE;">
<table height="90%" width= "90%" border="0" align="center">
<tr>
<td align="center" colspan="2">
<h2>Create Universal Distribution Group</h2>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>The selected OU below will be used by either script to create groups in.</b>
</td>
</tr>
<tr>
<td>
<b>Site Filter:</b>
</td>
<td>
<select size='1' name='lst_SiteFilter' onChange='vbs:Show_Selection'>
</select>
</td>
</tr>
<tr>
<td colspan=2>
<b>Site Selected:</b>   <span id='span_SiteFilter'></span>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Assign a Manager</b><br>
The format of the CSV file must be<br>
<Group Name>,<Group Description>,<Manager Full Name><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_manager" name="txt_groups_and_manager">
<input type='button' value='Browse...' name='btn_browse_groups_and_manager' onClick='vbs:Get_Groups_And_Manager_CSV_File'><br><br>
<button name="btn_run_groups_and_manager" id="btn_run_groups_and_manager" onclick="vbs:Create_Groups_And_Manager">Run</button>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Add Users To Them</b><br>
The format of the CSV file must be<br>
<Group Name>,<samAccountName of Group Member><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_users" name="txt_groups_and_users">
<input type='button' value='Browse...' name='btn_browse_groups_and_users' onClick='vbs:Get_Groups_And_Users_CSV_File'><br><br>
<button name="btn_run_groups_and_users" id="btn_run_groups_and_users" onclick="vbs:Create_Groups_And_Users">Run</button>
</td>
</tr>
</table>
<table width= "90%" border="0" align="center">
<tr align="center">
<td>
<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
</td>
</tr>
</table>
</body>
</head>
</html>
ASKER
Amazing Rob!!
Can you help with a logo in the top and also a clear button to refresh?
Your are outstanding
regards
Chandru
Can you help with a logo in the top and also a clear button to refresh?
Your are outstanding
regards
Chandru
ASKER
One more request for putting in the domain name and the username in the HTA in the right corner and key in the password there to run the scripts
regards
Chandru
regards
Chandru
OK, this should do it.
Again, you'll need to change
strRequiredDomain = "YOURDOMAIN"
strPSExecPath = "\\server\share\psexec.exe "
Regards,
Rob.
Again, you'll need to change
strRequiredDomain = "YOURDOMAIN"
strPSExecPath = "\\server\share\psexec.exe
Regards,
Rob.
<Html>
<Head>
<Title>Create Universal Distribution Group</Title>
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
<script Language = VBScript>
Dim strHTAPath
Sub Window_OnLoad
intWidth = 800
intHeight = 600
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
'Check if this HTA is running under the correct account
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strCurrentDomain = wshNetwork.UserDomain
strCurrentUser = wshNetwork.UserName
strRequiredDomain = "YOURDOMAIN"
strRequiredUser = "Administrator"
span_requireduser.InnerHTML = strRequiredDomain & "\" & strRequiredUser
span_requireduser2.InnerHTML = strRequiredDomain & "\" & strRequiredUser
span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
If Mid(document.location, 6, 3) = "///" Then
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
Else
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
Disable_Controls
Else
Enable_Controls
End If
Set objRootDSE = GetObject("LDAP://RootDSE")
strBaseConnString = objRootDSE.Get("defaultNamingContext")
Set objOULevel = GetObject("LDAP://" & strBaseConnString)
RecurseOUs objOULevel, 0, strBaseConnString
Show_Selection
End Sub
Sub Disable_Controls
txt_password.disabled = False
btn_reload.disabled = False
lst_SiteFilter.disabled = True
txt_groups_and_manager.disabled = True
btn_browse_groups_and_manager.disabled = True
btn_run_groups_and_manager.disabled = True
txt_groups_and_users.disabled = True
btn_browse_groups_and_users.disabled = True
btn_run_groups_and_users.disabled = True
End Sub
Sub Enable_Controls
txt_password.disabled = True
btn_reload.disabled = True
lst_SiteFilter.disabled = False
txt_groups_and_manager.disabled = False
btn_browse_groups_and_manager.disabled = False
btn_run_groups_and_manager.disabled = False
txt_groups_and_users.disabled = False
btn_browse_groups_and_users.disabled = False
btn_run_groups_and_users.disabled = False
End Sub
Sub Reload_HTA
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strPSExecPath = "\\server\share\psexec.exe"
strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & span_requireduser.InnerHTML & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
'InputBox "Prompt", "Title", strCommand
objShell.Run strCommand, 0, False
Window.Close
End Sub
Sub RecurseOUs(objOU, intLevel, strBaseConn)
Dim objOUObject, strConnString, objActiveOption
For Each objOUObject In objOU
If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
strConnString = objOUObject.DistinguishedName
Set objActiveOption = Document.CreateElement("OPTION")
If intLevel = 0 Then
objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
Else
objActiveOption.Text = String(intLevel * 4, " ") & "-> " & Replace(objOUObject.Name, "OU=", "")
End If
objActiveOption.Value = strConnString
lst_SiteFilter.Add objActiveOption
RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
End If
Next
End Sub
Sub Show_Selection
span_SiteFilter.InnerHTML = lst_SiteFilter.Value
End Sub
Sub Exit_HTA
Window.Close
End Sub
Sub Get_Groups_and_Manager_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_manager.Value = objDialog.FileName
End Sub
Sub Get_Groups_and_Users_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_users.Value = objDialog.FileName
End Sub
Sub Create_Groups_And_Manager
If Trim(txt_groups_and_manager.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_manager.Focus
Else
'Sample INPUT
'Grpname,This is a test grp,Ownername
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strCSVFile = txt_groups_and_manager.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = createobject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strInput(0)
objGroup.SetInfo
objGroup.description = strInput(1)
objGroup.SetInfo
'objGroup.MailEnable
'objGroup.SetInfo
Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM 'LDAP://" & objRootDSE.get("defaultNamingContext") & "' WHERE objectCategory='User' " & "AND CN='" & strInput(2) & "'"
Set objRecordSet2 = objCommand2.Execute
'wscript.echo objRecordSet2.Fields("Adspath").Value
If Not objRecordSet2.EOF then
objGroup.Put "managedby" , Trim(Replace(objRecordSet2.Fields("adspath").Value,"LDAP://"," "))
objGroup.SetInfo
Set objSD = objGroup.Get("ntSecurityDescriptor")
Set objDACL = objSD.DiscretionaryAcl
Set objACE = CreateObject("AccessControlEntry")
objACE.Trustee = objRecordSet2.Fields("UserprincipalName").Value
objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
objACE.AceFlags = 0
objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
objACE.ObjectType = MEMBER_ATTRIBUTE
objDACL.AddAce objACE
objSD.DiscretionaryAcl = objDACL
objGroup.Put "ntSecurityDescriptor", objSD
objGroup.SetInfo
End If
Loop
MsgBox "Groups have been created."
End If
End Sub
Sub Create_Groups_And_Users
If Trim(txt_groups_and_users.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_users.Focus
Else
'Sample INPUT
'Grpname,samAccountName
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strLogFile = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "CreatedGroups.log"
strCSVFile = txt_groups_and_users.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
strResults = "Creating groups in " & strLDapPath & " from " & strCSVFile
strResults = strResults & VbCrLf & "Script started: " & Now
strResults = strResults & VbCrLf & "===============================" & VbCrLf
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = CreateObject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
strUser = strInput(1)
strGroupADsPath = Get_LDAP_User_Properties("group", "samAccountName", strGrpName, "adsPath")
boolValid = True
If InStr(strGroupADsPath, "LDAP://") = 0 Then
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strGrpName
objGroup.SetInfo
strResults = strResults & VbCrLf & strGrpName & " created."
ElseIf LCase(strGroupADsPath) <> LCase("LDAP://cn=" & strGrpName & "," & objOU.distinguishedName) Then
strResults = strResults & VbCrLf & "Another group exists with a samAccountName of " & strGrpName & VbCrLf & strGroupADsPath & VbCrLf & "LDAP://cn=" & strGrpName & "," & objOU.distinguishedName
boolValid = False
Else
strResults = strResults & VbCrLf & strGrpName & " already exists."
Set objGroup = GetObject(strGroupADsPath)
End If
If boolValid = True Then
strUserADsPath = Get_LDAP_User_Properties("user", "samAccountName", strUser, "adsPath")
If InStr(strUserADsPath, "LDAP://") > 0 Then
On Error Resume Next
objGroup.Add strUserADsPath
If Err.Number <> 0 Then
Err.Clear
strResults = strResults & VbCrLf & strUser & " is already a member of " & strGrpName
Else
strResults = strResults & VbCrLf & strUser & " was added to " & strGrpName
End If
On Error GoTo 0
Else
strResults = strResults & VbCrLf & "Unable to find " & strUser
End If
End If
Loop
strResults = strResults & VbCrLf & "===========================" & VbCrLf & "Script finished: " & Now
Set objLog = ObjFSO.CreateTextFile(strLogFile, True)
objLog.Write strResults
objLog.Close
Set objLog = Nothing
MsgBox "Script finished. Please see " & strLogFile
End If
End Sub
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 = "<LDAP://" & strDNSDomain & ">"
' 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
</script>
<body style="background-color:#B0C4DE;">
<table width= "90%" border="0" align="center">
<tr>
<td align="center" colspan="2">
<h2>Create Universal Distribution Group</h2>
</td>
</tr>
<tr>
<td align="left" valign="top">
<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
</td>
<td>
Script must be run as <span id="span_requireduser"></span><br>
Script is currently run as <span id="span_currentuser"></span><br><br>
Enter the password for <span id="span_requireduser2"> </span><br>
Password: <input type="password" id="txt_password" name="txt_password" size="20">
<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
<br><br>
</td>
</tr> <tr>
<td align="center" colspan="2">
<b>The selected OU below will be used by either script to create groups in.</b>
</td>
</tr>
<tr>
<td>
<b>Site Filter:</b>
</td>
<td>
<select size='1' name='lst_SiteFilter' onChange='vbs:Show_Selection'>
</select>
</td>
</tr>
<tr>
<td colspan=2>
<b>Site Selected:</b>   <span id='span_SiteFilter'></span>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Assign a Manager</b><br>
The format of the CSV file must be<br>
<Group Name>,<Group Description>,<Manager Full Name><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_manager" name="txt_groups_and_manager">
<input type='button' value='Browse...' name='btn_browse_groups_and_manager' onClick='vbs:Get_Groups_And_Manager_CSV_File'><br><br>
<button name="btn_run_groups_and_manager" id="btn_run_groups_and_manager" onclick="vbs:Create_Groups_And_Manager">Run</button>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Add Users To Them</b><br>
The format of the CSV file must be<br>
<Group Name>,<samAccountName of Group Member><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_users" name="txt_groups_and_users">
<input type='button' value='Browse...' name='btn_browse_groups_and_users' onClick='vbs:Get_Groups_And_Users_CSV_File'><br><br>
<button name="btn_run_groups_and_users" id="btn_run_groups_and_users" onclick="vbs:Create_Groups_And_Users">Run</button>
</td>
</tr>
</table>
<table width= "90%" border="0" align="center">
<tr align="center">
<td>
<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
</td>
</tr>
</table>
</body>
</head>
</html>
ASKER
Want to learn HTA Rob! Suggestions....
Can we have the username also input in the HTA rather than hard coding in the script?
regards
Chandru
Can we have the username also input in the HTA rather than hard coding in the script?
regards
Chandru
OK, so here's the HTA with the username able to be entered directly.
You can still change this
strRequiredDomain = "YOURDOMAIN"
strRequiredUser = "Administrator"
and this
strPSExecPath = "\\server\share\psexec.exe "
The username and password that you put in the code is just a default, but can be changed when the HTA loads.
As far as learning HTAs goes.....this is a start:
http://www.microsoft.com/technet/scriptcenter/hubs/htas.mspx
It's hard to say where to start really.....
There's lots of HTAs on EE for you to look at, and get an idea of how they work.
Basically, you first needs to think about your interface, which you write in pure HTML code. So I guess learning how to make HTML pages would be a good starting point. I guess you could use a graphical web page editor, and then dive into the code later to add the VBScript, but I code all mine from just text.
The basic idea is that you build your graphical HTML interface, then you start adding onClick events to the buttons, which call a VBScript routine. That VBScript routine then gets values from your HTML elements, such as text boxes, and does normal VBScript stuff with them.
Regards,
Rob.
You can still change this
strRequiredDomain = "YOURDOMAIN"
strRequiredUser = "Administrator"
and this
strPSExecPath = "\\server\share\psexec.exe
The username and password that you put in the code is just a default, but can be changed when the HTA loads.
As far as learning HTAs goes.....this is a start:
http://www.microsoft.com/technet/scriptcenter/hubs/htas.mspx
It's hard to say where to start really.....
There's lots of HTAs on EE for you to look at, and get an idea of how they work.
Basically, you first needs to think about your interface, which you write in pure HTML code. So I guess learning how to make HTML pages would be a good starting point. I guess you could use a graphical web page editor, and then dive into the code later to add the VBScript, but I code all mine from just text.
The basic idea is that you build your graphical HTML interface, then you start adding onClick events to the buttons, which call a VBScript routine. That VBScript routine then gets values from your HTML elements, such as text boxes, and does normal VBScript stuff with them.
Regards,
Rob.
<Html>
<Head>
<Title>Create Universal Distribution Group</Title>
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
<script Language = VBScript>
Dim strHTAPath
Sub Window_OnLoad
intWidth = 800
intHeight = 600
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
'Check if this HTA is running under the correct account
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strCurrentDomain = wshNetwork.UserDomain
strCurrentUser = wshNetwork.UserName
strRequiredDomain = "YOURDOMAIN"
strRequiredUser = "Administrator"
txt_username.Value = strRequiredDomain & "\" & strRequiredUser
span_username2.InnerHTML = txt_username.Value
span_currentuser.InnerHTML = strCurrentDomain & "\" & strCurrentUser
If Mid(document.location, 6, 3) = "///" Then
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
Else
strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
'If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
'Disable_Controls
'Else
'Enable_Controls
'End If
Set objRootDSE = GetObject("LDAP://RootDSE")
strBaseConnString = objRootDSE.Get("defaultNamingContext")
Set objOULevel = GetObject("LDAP://" & strBaseConnString)
RecurseOUs objOULevel, 0, strBaseConnString
Show_Selection
End Sub
Sub Update_UserName2
span_username2.InnerHTML = txt_username.Value
End Sub
Sub Disable_Controls
txt_password.disabled = False
btn_reload.disabled = False
lst_SiteFilter.disabled = True
txt_groups_and_manager.disabled = True
btn_browse_groups_and_manager.disabled = True
btn_run_groups_and_manager.disabled = True
txt_groups_and_users.disabled = True
btn_browse_groups_and_users.disabled = True
btn_run_groups_and_users.disabled = True
End Sub
Sub Enable_Controls
txt_password.disabled = True
btn_reload.disabled = True
lst_SiteFilter.disabled = False
txt_groups_and_manager.disabled = False
btn_browse_groups_and_manager.disabled = False
btn_run_groups_and_manager.disabled = False
txt_groups_and_users.disabled = False
btn_browse_groups_and_users.disabled = False
btn_run_groups_and_users.disabled = False
End Sub
Sub Reload_HTA
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set wshNetwork = CreateObject("WScript.Network")
If txt_username.Value <> "" And txt_password.Value <> "" Then
strComputer = wshNetwork.ComputerName
strPSExecPath = "\\server\share\psexec.exe"
strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & txt_username.Value & " -p " & txt_password.Value & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
'InputBox "Prompt", "Title", strCommand
objShell.Run strCommand, 0, False
Window.Close
Else
MsgBox "Please enter an alternate username and password to run the HTA as."
End If
End Sub
Sub RecurseOUs(objOU, intLevel, strBaseConn)
Dim objOUObject, strConnString, objActiveOption
For Each objOUObject In objOU
If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
strConnString = objOUObject.DistinguishedName
Set objActiveOption = Document.CreateElement("OPTION")
If intLevel = 0 Then
objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
Else
objActiveOption.Text = String(intLevel * 4, " ") & "-> " & Replace(objOUObject.Name, "OU=", "")
End If
objActiveOption.Value = strConnString
lst_SiteFilter.Add objActiveOption
RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
End If
Next
End Sub
Sub Show_Selection
span_SiteFilter.InnerHTML = lst_SiteFilter.Value
End Sub
Sub Exit_HTA
Window.Close
End Sub
Sub Get_Groups_and_Manager_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_manager.Value = objDialog.FileName
End Sub
Sub Get_Groups_and_Users_CSV_File
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
objDialog.FilterIndex = 1
objDialog.InitialDir = "."
intResult = objDialog.ShowOpen
If intResult = 0 Then
Exit Sub
End If
txt_groups_and_users.Value = objDialog.FileName
End Sub
Sub Create_Groups_And_Manager
If Trim(txt_groups_and_manager.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_manager.Focus
Else
'Sample INPUT
'Grpname,This is a test grp,Ownername
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strCSVFile = txt_groups_and_manager.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = createobject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strInput(0)
objGroup.SetInfo
objGroup.description = strInput(1)
objGroup.SetInfo
'objGroup.MailEnable
'objGroup.SetInfo
Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM 'LDAP://" & objRootDSE.get("defaultNamingContext") & "' WHERE objectCategory='User' " & "AND CN='" & strInput(2) & "'"
Set objRecordSet2 = objCommand2.Execute
'wscript.echo objRecordSet2.Fields("Adspath").Value
If Not objRecordSet2.EOF then
objGroup.Put "managedby" , Trim(Replace(objRecordSet2.Fields("adspath").Value,"LDAP://"," "))
objGroup.SetInfo
Set objSD = objGroup.Get("ntSecurityDescriptor")
Set objDACL = objSD.DiscretionaryAcl
Set objACE = CreateObject("AccessControlEntry")
objACE.Trustee = objRecordSet2.Fields("UserprincipalName").Value
objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
objACE.AceFlags = 0
objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
objACE.ObjectType = MEMBER_ATTRIBUTE
objDACL.AddAce objACE
objSD.DiscretionaryAcl = objDACL
objGroup.Put "ntSecurityDescriptor", objSD
objGroup.SetInfo
End If
Loop
MsgBox "Groups have been created."
End If
End Sub
Sub Create_Groups_And_Users
If Trim(txt_groups_and_users.Value) = "" Then
MsgBox "Please enter a CSV file path."
txt_groups_and_users.Focus
Else
'Sample INPUT
'Grpname,samAccountName
'Script Start
Const ADS_GROUP_TYPE_GLOBAL = &H2
Const ADS_GROUP_TYPE_LOCAL = &H4
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &h5
Const ADS_FLAG_OBJECT_TYPE_PRESENT = &h1
Const ADS_RIGHT_DS_WRITE_PROP = &h20
Const MEMBER_ATTRIBUTE = "{bf9679c0-0de6-11d0-a285-00aa003049e2}"
strLogFile = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "CreatedGroups.log"
strCSVFile = txt_groups_and_users.Value
strLDAPPath = "LDAP://" & span_SiteFilter.InnerHTML
strResults = "Creating groups in " & strLDapPath & " from " & strCSVFile
strResults = strResults & VbCrLf & "Script started: " & Now
strResults = strResults & VbCrLf & "===============================" & VbCrLf
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Provider = "ADsDSOObject"
objConnection2.Open "Active Directory Provider"
Set objCommand2.ActiveConnection = objConnection2
Set ObjFSO = CreateObject("Scripting.FilesystemObject")
Set ObjTextfile = ObjFSO.Opentextfile(strCSVFile)
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = Split(strGet,",")
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
StrGrpName = strInput(0)
strUser = strInput(1)
strGroupADsPath = Get_LDAP_User_Properties("group", "samAccountName", strGrpName, "adsPath")
boolValid = True
If InStr(strGroupADsPath, "LDAP://") = 0 Then
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
objGroup.sAMAccountName = strGrpName
objGroup.SetInfo
strResults = strResults & VbCrLf & strGrpName & " created."
ElseIf LCase(strGroupADsPath) <> LCase("LDAP://cn=" & strGrpName & "," & objOU.distinguishedName) Then
strResults = strResults & VbCrLf & "Another group exists with a samAccountName of " & strGrpName & VbCrLf & strGroupADsPath & VbCrLf & "LDAP://cn=" & strGrpName & "," & objOU.distinguishedName
boolValid = False
Else
strResults = strResults & VbCrLf & strGrpName & " already exists."
Set objGroup = GetObject(strGroupADsPath)
End If
If boolValid = True Then
strUserADsPath = Get_LDAP_User_Properties("user", "samAccountName", strUser, "adsPath")
If InStr(strUserADsPath, "LDAP://") > 0 Then
On Error Resume Next
objGroup.Add strUserADsPath
If Err.Number <> 0 Then
Err.Clear
strResults = strResults & VbCrLf & strUser & " is already a member of " & strGrpName
Else
strResults = strResults & VbCrLf & strUser & " was added to " & strGrpName
End If
On Error GoTo 0
Else
strResults = strResults & VbCrLf & "Unable to find " & strUser
End If
End If
Loop
strResults = strResults & VbCrLf & "===========================" & VbCrLf & "Script finished: " & Now
Set objLog = ObjFSO.CreateTextFile(strLogFile, True)
objLog.Write strResults
objLog.Close
Set objLog = Nothing
MsgBox "Script finished. Please see " & strLogFile
End If
End Sub
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 = "<LDAP://" & strDNSDomain & ">"
' 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
</script>
<body style="background-color:#B0C4DE;">
<table width= "90%" border="0" align="center">
<tr>
<td align="center" colspan="2">
<h2>Create Universal Distribution Group</h2>
</td>
</tr>
<tr>
<td align="left" valign="top">
<img name="img_logo" id="img_logo" height="100px" width="100px" src="c:\MyLogo.jpg">
</td>
<td>
Script is currently run as <span id="span_currentuser"></span><br><br>
Alternate credentials to run as: <input type="text" id="txt_username" name="txt_username" size="50" onkeyup="vbs:Update_username2"><br>
Enter the password for <span id="span_username2"> </span><br>
Password: <input type="password" id="txt_password" name="txt_password" size="20">
<button name="btn_reload" id="btn_reload" accessKey="l" onclick="vbs:Reload_HTA">Re<u>l</u>oad</button>
<br><br>
</td>
</tr> <tr>
<td align="center" colspan="2">
<b>The selected OU below will be used by either script to create groups in.</b>
</td>
</tr>
<tr>
<td>
<b>Site Filter:</b>
</td>
<td>
<select size='1' name='lst_SiteFilter' onChange='vbs:Show_Selection'>
</select>
</td>
</tr>
<tr>
<td colspan=2>
<b>Site Selected:</b>   <span id='span_SiteFilter'></span>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Assign a Manager</b><br>
The format of the CSV file must be<br>
<Group Name>,<Group Description>,<Manager Full Name><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_manager" name="txt_groups_and_manager">
<input type='button' value='Browse...' name='btn_browse_groups_and_manager' onClick='vbs:Get_Groups_And_Manager_CSV_File'><br><br>
<button name="btn_run_groups_and_manager" id="btn_run_groups_and_manager" onclick="vbs:Create_Groups_And_Manager">Run</button>
</td>
</tr>
<tr>
<td align="center" colspan="2">
<b>Create Groups From CSV File and Add Users To Them</b><br>
The format of the CSV file must be<br>
<Group Name>,<samAccountName of Group Member><br>
<b>CSV File: </b><input type="text" size="70" id="txt_groups_and_users" name="txt_groups_and_users">
<input type='button' value='Browse...' name='btn_browse_groups_and_users' onClick='vbs:Get_Groups_And_Users_CSV_File'><br><br>
<button name="btn_run_groups_and_users" id="btn_run_groups_and_users" onclick="vbs:Create_Groups_And_Users">Run</button>
</td>
</tr>
</table>
<table width= "90%" border="0" align="center">
<tr align="center">
<td>
<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
</td>
</tr>
</table>
</body>
</head>
</html>
ASKER
Hi Rob,
Thanks!!
Can we hardcode the OU part instead of listing all the OU's?
regards
Chandru
Thanks!!
Can we hardcode the OU part instead of listing all the OU's?
regards
Chandru
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Rob!!