• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2370
  • Last Modified:

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
0
chandru_sol
Asked:
chandru_sol
  • 13
  • 9
  • 3
1 Solution
 
rejoinderCommented:
Please post a sample line from your CSV file.
0
 
chandru_solAuthor Commented:
Csv file will be of the format as below

Groupname,usersamaccountname

regards
Chandru
0
 
RobSampsonCommented:
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.
'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

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
chandru_solAuthor Commented:
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
0
 
RobSampsonCommented:
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.
0
 
chandru_solAuthor Commented:
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
0
 
RobSampsonCommented:
What kind of info?  What function would the second button have? Can you explain a bit more what you want on the HTA?

Rob.
0
 
chandru_solAuthor Commented:
HTA as below

Picture                     Header

Button1                   Notes1

Button2                   Notes2

regards
Chandru
0
 
rejoinderCommented:
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?
0
 
chandru_solAuthor Commented:
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
0
 
rejoinderCommented:
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.
0
 
RobSampsonCommented:
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.
0
 
chandru_solAuthor Commented:
Thanks Rob and Rejoineder!!

Rob,

I would like to have the two vbscripts with some user interface

regards
Chandru
0
 
RobSampsonCommented:
So, the two scripts, are they this one, and the VBS code from comment ID: 22809117 on
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23819287.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.
0
 
chandru_solAuthor Commented:
Yes those are the two scripts and notes button will have some information regarding the csv file

regards
Chandru
0
 
chandru_solAuthor Commented:
Hi Rob,

Did you get a chance to work on this HTA?

regards
Chandru
0
 
RobSampsonCommented:
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.
<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>&nbsp&nbsp&nbsp<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>
				&ltGroup Name&gt,&ltGroup Description&gt,&ltManager Full Name&gt<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>
				&ltGroup Name&gt,&ltsamAccountName of Group Member&gt<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>

Open in new window

0
 
chandru_solAuthor Commented:
Amazing Rob!!

Can you help with a logo in the top and also a clear button to refresh?

Your are outstanding

regards
Chandru
0
 
chandru_solAuthor Commented:
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
0
 
RobSampsonCommented:
OK, this should do it.

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">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<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>&nbsp&nbsp&nbsp<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>
				&ltGroup Name&gt,&ltGroup Description&gt,&ltManager Full Name&gt<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>
				&ltGroup Name&gt,&ltsamAccountName of Group Member&gt<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>

Open in new window

0
 
chandru_solAuthor Commented:
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
0
 
RobSampsonCommented:
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.
<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">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<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>&nbsp&nbsp&nbsp<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>
				&ltGroup Name&gt,&ltGroup Description&gt,&ltManager Full Name&gt<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>
				&ltGroup Name&gt,&ltsamAccountName of Group Member&gt<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>

Open in new window

0
 
chandru_solAuthor Commented:
Hi Rob,

Thanks!!
Can we hardcode the OU part instead of listing all the OU's?

regards
Chandru
0
 
RobSampsonCommented:
If you want.....you can change this line:
                        <b>Site Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'>OU=TestOU,OU=Sites,DC=yourdomain,DC=com</span>

so that this part of it
OU=TestOU,OU=Sites,DC=yourdomain,DC=com

matches an OU path in your domain.

I won't have any more time to work on this for the next two weeks, I am going on holiday.

I think you close out this question, and the one before it, and post a new question for others to look at if you need more assistance.

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
 
	End Sub
 
	Sub Update_UserName2
		span_username2.InnerHTML = txt_username.Value
	End Sub
 
	Sub Disable_Controls
		txt_password.disabled = False
		btn_reload.disabled = False
		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
		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 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">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<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 colspan=2>
				<b>Site Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'>OU=TestOU,OU=Sites,DC=yourdomain,DC=com</span>
				<br>
			</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>
				&ltGroup Name&gt,&ltGroup Description&gt,&ltManager Full Name&gt<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>
				&ltGroup Name&gt,&ltsamAccountName of Group Member&gt<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>

Open in new window

0
 
chandru_solAuthor Commented:
Thanks Rob!!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 13
  • 9
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now