Solved

vbscript for distribution groups

Posted on 2008-10-15
30
1,169 Views
Last Modified: 2012-05-05
Hi,

Can you help with the vbscript for creating mail enabled universal distribution groups from CSV file?

I have a code snippet already which i have attached

I would also like to have a script to export the members of a distrbution group to an excel file

regards
Chandru
Sample INPUT
universal,Grpname,This is a test grp,Ownername,OU1,OU2,OU3
'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}"
 
 
 
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("C:\dlinput.csv")
 
 
 
 
Do Until ObjTextfile.AtEndofStream
StrGet = ObjTextfile.ReadLine
StrInput = split(strGet,",")
StrLdappath = "LDAP:// YOUR LDAP PATH "
'wscript.echo strLdappath & " " & strInput(1)
Set objOU = GetObject(strLdappath)
 
 
Select Case StrInput(0)
Case "universal"
StrGrpName = strInput(1)
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
case Else
StrGrpName = strInput(1)
Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
objGroup.SetInfo
 
End Select
 
objGroup.sAMAccountName = Right (strInput(1),Len(StrInput(1))-1)
objGroup.SetInfo
objGroup.description = strInput(2)
objGroup.SetInfo
'wscript.echo strGrpName & "@" & strInput(6) & ".yourdomain.com"
objGroup.mail = strGrpName & "@" & strInput(6) & ".yourdomain.com"
objGroup.MailEnable
objGroup.Put "ProxyAddresses", "SMTP:" + "##-" + strInput(1) + "@" + strInput(6) + ".yourdomain.com"
objGroup.SetInfo
 
'wscript.echo strInput(3)
objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM 'LDAP:\\Your LDAP PATH' WHERE objectCategory='User' " & "AND CN='" & strInput(3) & "'"
Set objRecordSet2 = objCommand2.Execute
objRecordSet2.MoveFirst
'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
 
 
 
 
 
 
wscript.echo "Group named " & strinput(1) & " is created"
Loop
 
Wscript.echo "***** Script End *****"
'Script end

Open in new window

0
Comment
Question by:chandru_sol
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 17
  • 13
30 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 22762655
Hi Chandru, does this script have a problem, or do you just need extra features?

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22764574
Hi Rob,

Do you have  a similar script which created mail enabled distribution groups from csv file?

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22764778
No. But I'd expect these line do the main job.....does it not work?

objGroup.mail = strGrpName & "@" & strInput(6) & ".yourdomain.com"
objGroup.MailEnable
objGroup.Put "ProxyAddresses", "SMTP:" + "##-" + strInput(1) + "@" + strInput(6) + ".yourdomain.com"
objGroup.SetInfo


Regards,

Rob.
0
Technology Partners: 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!

 
LVL 12

Author Comment

by:chandru_sol
ID: 22764990
Rob,

Can you help me with a HTA for the same to create distribution groups by filling in the relevant details?

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22773872
Rob,

HTA with input from CSV can be achieved

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22798783
Hi Rob,

Any luck with the HTA

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22805664
Sorry, haven't had much time...should be able to this week....

Which parameters do you need input for in the HTA?  Does the code actually work?  Are there any problems with it, or will it work just fine?

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22806970
Hi Rob,

Can we have only the group name as input in the HTA? I haven't tested the above script

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22809117
OK, so here's the code to create the groups from a CSV file....I'll work in a HTA....

Regards,

Rob.
'Sample INPUT
'universal,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 = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "GroupsToCreate.csv"
strInternetDomain = "your.internet.domain.name"
strOU = "OU=Users,OU=Main Site,OU=Sites,"
If strOU <> "" Then
	If Right(strOU, 1) <> "," Then strOU = strOU & ","
End If
Set objRootDSE = GetObject("LDAP://RootDSE")
strLDAPPath = "LDAP://" & strOU & objRootDSE.Get("defaultNamingContext")
 
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)
	
	Select Case StrInput(0)
		Case "universal"
			StrGrpName = strInput(1)
			Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
			objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
			objGroup.SetInfo
		case Else
			StrGrpName = strInput(1)
			Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
			objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
			objGroup.SetInfo	 
	End Select
	 
	objGroup.sAMAccountName = Right(strInput(1),Len(StrInput(1))-1)
	objGroup.SetInfo
	objGroup.description = strInput(2)
	objGroup.SetInfo
 
	objGroup.mail = strGrpName & "@" & strInternetDomain
	objGroup.MailEnable
	objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strInput(1) & "@" & strInternetDomain
	objGroup.SetInfo
	 
	'wscript.echo strInput(3)
	objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM '" & strLDAPPath & "' WHERE objectCategory='User' " & "AND CN='" & strInput(3) & "'"
	Set objRecordSet2 = objCommand2.Execute
	objRecordSet2.MoveFirst
	'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
 
	wscript.echo "Group named " & strinput(1) & " is created"
Loop
 
Wscript.echo "***** Script End *****"
'Script end

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22809284
OK, finally got there.....try this HTA out....

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>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
    	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 Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Check_Controls
		If chk_mailenable.Checked = True Then
			txt_internetdomain.disabled = False
			txt_internetdomain.style.backgroundColor = "#FFFFFF"
		Else
			txt_internetdomain.disabled = True
			txt_internetdomain.style.backgroundColor = "#D3D3D3"
		End If
	End Sub
 
	Sub Create_Group
		'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}"
		
		strInternetDomain = txt_internetdomain.Value
		strOU = lst_sitefilter.Value
		'If strOU <> "" Then
		'	If Right(strOU, 1) <> "," Then strOU = strOU & ","
		'End If
		'Set objRootDSE = GetObject("LDAP://RootDSE")
		'strLDAPPath = "LDAP://" & strOU & objRootDSE.Get("defaultNamingContext")
		strLDAPPath = "LDAP://" & strOU
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		Set objOU = GetObject(strLDAPPath)
		
		StrGrpName = txt_groupname.Value
		Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
		objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
		objGroup.SetInfo
		
		'objGroup.sAMAccountName = Right(strGrpName,Len(strGrpName)-1)
		objGroup.samAccountName = strGrpName
		objGroup.SetInfo
		objGroup.description = txt_description.Value
		objGroup.SetInfo
		
		If chk_mailenable.Checked = True Then
			objGroup.mail = strGrpName & "@" & strInternetDomain
			objGroup.MailEnable
			objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strGrpName & "@" & strInternetDomain
			objGroup.SetInfo
		End If
		
		strManager = txt_manager.Value
		If strManager <> "" Then
			objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM '" & strLDAPPath & "' WHERE objectCategory='User' " & "AND CN='" & strManager & "'"
			Set objRecordSet2 = objCommand2.Execute
			objRecordSet2.MoveFirst
			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
		End If
		
		MsgBox "Group named " & strGrpName & " has been created"
		'Script end
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="2">
				<h2>Create Universal Distribution Group</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group name:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_groupname" name="txt_groupname">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group description:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_description" name="txt_description">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group manager:</b>
			</td>
			<td>
				<input type="text" maxlength="40" size="50" id="txt_manager" name="txt_manager">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<b>Mail Enable this group:</b> <input type="checkbox" checked id="chk_mailenable" name="chk_mailenable" onclick="vbs:Check_Controls">
			</td>
		</tr>
		<tr>
			<td>
				<b>Internet domain:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_internetdomain" name="txt_internetdomain">
			</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 align="center">
			<td>
				<button name="btn_run" id="btn_run" accessKey="C" onclick="vbs:Create_Group"><u>C</u>reate Group</button>
			</td>
			<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
 
LVL 12

Author Comment

by:chandru_sol
ID: 22815241
If the fields are left blank the groups will be created without that information right.

Or all the fields are mandatory

Can we have a clear button to clear the screen?

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22819259
The group name and internet domain (if you mail enable the group) is mandatory, the description and manager is optional.

I can build a clear button tomorrow when I'm at work....

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22827236
OK, this now has a clear button.

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>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
    	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 Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Check_Controls
		If chk_mailenable.Checked = True Then
			txt_internetdomain.disabled = False
			txt_internetdomain.style.backgroundColor = "#FFFFFF"
		Else
			txt_internetdomain.disabled = True
			txt_internetdomain.style.backgroundColor = "#D3D3D3"
		End If
	End Sub
 
	Sub Reset_Form
		txt_groupname.Value = ""
		txt_description.Value = ""
		txt_manager.Value = ""
		chk_mailenable.Checked = True
		txt_internetdomain.Value = ""
	End Sub
 
	Sub Create_Group
		If Trim(txt_groupname.Value) = "" Then
			MsgBox "Please enter a group name."
			txt_groupname.Focus
		ElseIf chk_mailenable.Checked = True And Trim(txt_internetdomain.Value) = "" Then
			MsgBox "Please enter an internet domain name."
			txt_internetdomain.Focus
		Else
			'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}"
			
			strInternetDomain = txt_internetdomain.Value
			strOU = lst_sitefilter.Value
			'If strOU <> "" Then
			'	If Right(strOU, 1) <> "," Then strOU = strOU & ","
			'End If
			'Set objRootDSE = GetObject("LDAP://RootDSE")
			'strLDAPPath = "LDAP://" & strOU & objRootDSE.Get("defaultNamingContext")
			strLDAPPath = "LDAP://" & strOU
			
			Set objConnection2 = CreateObject("ADODB.Connection")
			Set objCommand2 = CreateObject("ADODB.Command")
			objConnection2.Provider = "ADsDSOObject"
			objConnection2.Open "Active Directory Provider"
			Set objCommand2.ActiveConnection = objConnection2
			
			Set objOU = GetObject(strLDAPPath)
			
			StrGrpName = txt_groupname.Value
			Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
			objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
			objGroup.SetInfo
			
			'objGroup.sAMAccountName = Right(strGrpName,Len(strGrpName)-1)
			objGroup.samAccountName = strGrpName
			objGroup.SetInfo
			objGroup.description = txt_description.Value
			objGroup.SetInfo
			
			If chk_mailenable.Checked = True Then
				objGroup.mail = strGrpName & "@" & strInternetDomain
				objGroup.MailEnable
				objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strGrpName & "@" & strInternetDomain
				objGroup.SetInfo
			End If
			
			strManager = txt_manager.Value
			If strManager <> "" Then
				objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM '" & strLDAPPath & "' WHERE objectCategory='User' " & "AND CN='" & strManager & "'"
				Set objRecordSet2 = objCommand2.Execute
				objRecordSet2.MoveFirst
				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
			End If
			
			MsgBox "Group named " & strGrpName & " has been created"
			'Script end
		End If
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<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>
				<b>Enter group name:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_groupname" name="txt_groupname">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group description:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_description" name="txt_description">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group manager:</b>
			</td>
			<td>
				<input type="text" maxlength="40" size="50" id="txt_manager" name="txt_manager">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<b>Mail Enable this group:</b> <input type="checkbox" checked id="chk_mailenable" name="chk_mailenable" onclick="vbs:Check_Controls">
			</td>
		</tr>
		<tr>
			<td>
				<b>Internet domain:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_internetdomain" name="txt_internetdomain">
			</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>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_run" id="btn_run" accessKey="C" onclick="vbs:Create_Group"><u>C</u>reate Group</button>
			</td>
			<td>
				<button name="btn_reset" id="btn_reset" accessKey="l" onclick="vbs:Reset_Form"><u>R</u>eset Form</button>
			</td>
			<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
 
LVL 12

Author Comment

by:chandru_sol
ID: 22827949
Hi Rob,

Can we have a runas form in the same HTA to run the script?
Key in the username and password and then click run to script to runas some other user

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22828045
Um, not really, creating a circular program to launch itself gets fiddly.  What you can do, is run this HTA first, and point strSecondHTAPath to the second HTA.

Regards,

Rob.
<html>
<head>
<title>Run Program With Alternate Credentials</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Run Program With Alternate Credentials"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
 
<script language="VBScript">
 
Dim strPSExecPath
Dim strComputer
Dim strSecondHTAPath
 
Sub Window_onLoad
	intWidth = 600
	intHeight = 480
	Me.ResizeTo intWidth, intHeight
    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    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
    strPSExecPath = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "psexec.exe"
    strSecondHTAPath = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "TestHTA2.hta"
    If objFSO.FileExists(strPSExecPath) Then
    	strPSExecPath = objFSO.GetFile(strPSExecPath).ShortPath
    Else
    	MsgBox "Could not find PSExec at:" & VbCrLf & strPSExecPath
    	Window.Close
    End If
    Set objNetwork = CreateObject("WScript.Network")
    strComputer = objNetwork.ComputerName
    
    txt_username.Focus
End Sub
 
Sub Default_Buttons
	If Window.Event.KeyCode = 13 Then
		btn_submit.Click
	End If
End Sub
 
Sub Run_Second_HTA
	If txt_username.Value = "" Then
		MsgBox "Please enter a user name."
		txt_username.Focus
	ElseIf txt_password.Value = "" Then
		MsgBox "Please enter a password."
		txt_password.Focus
	Else
		Set objShell = CreateObject("WScript.Shell")
		strUser = txt_username.Value
		strPass = txt_password.Value
		strCommand = strPSExecPath & " -accepteula -i -d -u " & strUser & " -p " & strPass & " \\" & strComputer & " mshta.exe """ & strSecondHTAPath & """"
		'MsgBox strCommand
		' Exit Code 1326 is invalid password from PSExec 1.85
		strExitCode = objShell.Run(strCommand, 0, True)
		If strExitCode = 1326 Then
			MsgBox "Username or Password invalid. Please verify your credentials."
			txt_password.Value = ""
			txt_password.Focus
		Else
			window.close
		End If
	End If
End Sub
 
</script>
</head>
<body style="background-color:#B0C4DE" onkeypress='vbs:Default_Buttons'>
	<table width='90%' height='100%' align='center' border='0'>
		<tr>
			<td align="center" style="font-family: arial; font-size: 24px; font-weight: bold;">
				Run Program With Alternate Credentials
			</td>
		</tr>
		<tr>
			<td align='center' style="font-family: arial; font-size: 16px; font-weight: bold;">
				Enter username: <input type="text" maxlength="30" size="40" id="txt_username" name="txt_username" style="font-size: 14px;"><BR><BR>
				Enter password: <input type="password" maxlength="30" size="40" id="txt_password" name="txt_password" style="font-size: 14px;"><BR>
				<br>Note: Username must be DOMAIN\UserName
			</td>
		</tr>
		<tr>
			<td align='center'>
				<input type="button" value="Go!" name="btn_submit"  onClick="vbs:Run_Second_HTA" style="font-size: 16px;"><br><br>
			</td>
		</tr>
	</table>
</body>
</html>

Open in new window

0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22828217
Hi Rob,

I remember you doing this in one of the HTA long before

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22828238
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22828874
Hi Rob,

I get an error at line 118
Do i need to give the samaccount name for the Manager?

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22836939
Hmmm, that could mean that you already have a group name in another OU, with the same samAccountName.....can you check?
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22837428
No i checked, there is no group

but after the error when i click run the script it runs and creates the groups

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22837656
Can you please post the exact error message, and your line that you have the error on?
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22838015
Can you let me know what should be in the Manager name?

Sam accout name or the full distinguished name

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22838022
Did you see the other question for the runas in the same HTA?

regards
Chandru
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 22846176
>> Can you let me know what should be in the Manager name?

Sorry, you need to specify the full Display Name, like John Smith

And yes, now that I look at how I coded that HTA before, it's not that difficult....  :-)

Try this.  You'll need to change
            strRequiredDomain = "YOURDOMAIN"
            strRequiredUser = "Administrator"

and this
                        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>
 
	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 Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Check_Controls
		If chk_mailenable.Checked = True Then
			txt_internetdomain.disabled = False
			txt_internetdomain.style.backgroundColor = "#FFFFFF"
		Else
			txt_internetdomain.disabled = True
			txt_internetdomain.style.backgroundColor = "#D3D3D3"
		End If
	End Sub
 
	Sub Reset_Form
		txt_groupname.Value = ""
		txt_description.Value = ""
		txt_manager.Value = ""
		chk_mailenable.Checked = True
		txt_internetdomain.Value = ""
	End Sub
 
	Sub Create_Group
		If Trim(txt_groupname.Value) = "" Then
			MsgBox "Please enter a group name."
			txt_groupname.Focus
		ElseIf chk_mailenable.Checked = True And Trim(txt_internetdomain.Value) = "" Then
			MsgBox "Please enter an internet domain name."
			txt_internetdomain.Focus
		Else
			'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}"
			
			strInternetDomain = txt_internetdomain.Value
			strOU = lst_sitefilter.Value
			'If strOU <> "" Then
			'	If Right(strOU, 1) <> "," Then strOU = strOU & ","
			'End If
			'Set objRootDSE = GetObject("LDAP://RootDSE")
			'strLDAPPath = "LDAP://" & strOU & objRootDSE.Get("defaultNamingContext")
			strLDAPPath = "LDAP://" & strOU
			
			Set objConnection2 = CreateObject("ADODB.Connection")
			Set objCommand2 = CreateObject("ADODB.Command")
			objConnection2.Provider = "ADsDSOObject"
			objConnection2.Open "Active Directory Provider"
			Set objCommand2.ActiveConnection = objConnection2
			
			Set objOU = GetObject(strLDAPPath)
			
			StrGrpName = txt_groupname.Value
			Set objGroup = objOU.Create("Group", "cn=" & strGrpName )
			objGroup.groupType = ADS_GROUP_TYPE_UNIVERSAL
			objGroup.SetInfo
			
			'objGroup.sAMAccountName = Right(strGrpName,Len(strGrpName)-1)
			objGroup.samAccountName = strGrpName
			objGroup.SetInfo
			objGroup.description = txt_description.Value
			objGroup.SetInfo
			
			If chk_mailenable.Checked = True Then
				objGroup.mail = strGrpName & "@" & strInternetDomain
				objGroup.MailEnable
				objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strGrpName & "@" & strInternetDomain
				objGroup.SetInfo
			End If
			
			strManager = txt_manager.Value
			If strManager <> "" Then
				objCommand2.CommandText ="SELECT Userprincipalname,adspath,distinguishedName FROM '" & strLDAPPath & "' WHERE objectCategory='User' " & "AND CN='" & strManager & "'"
				Set objRecordSet2 = objCommand2.Execute
				objRecordSet2.MoveFirst
				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
			End If
			
			MsgBox "Group named " & strGrpName & " has been created"
			'Script end
		End If
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<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>
				<b>Enter group name:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_groupname" name="txt_groupname">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group description:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_description" name="txt_description">
			</td>
		</tr>
		<tr>
			<td>
				<b>Enter group manager:</b>
			</td>
			<td>
				<input type="text" maxlength="40" size="50" id="txt_manager" name="txt_manager">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<b>Mail Enable this group:</b> <input type="checkbox" checked id="chk_mailenable" name="chk_mailenable" onclick="vbs:Check_Controls">
			</td>
		</tr>
		<tr>
			<td>
				<b>Internet domain:</b>
			</td>
			<td>
				<input type="text" maxlength="30" size="50" id="txt_internetdomain" name="txt_internetdomain">
			</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>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_run" id="btn_run" accessKey="C" onclick="vbs:Create_Group"><u>C</u>reate Group</button>
			</td>
			<td>
				<button name="btn_reset" id="btn_reset" accessKey="l" onclick="vbs:Reset_Form"><u>R</u>eset Form</button>
			</td>
			<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
 
LVL 12

Author Comment

by:chandru_sol
ID: 22847664
Hi Rob,

Thanks for the code!!

Can you help me to create the distrubution groups from csv file. A browse button in the HTA to have all the information and some error logging in the file if some user failed

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22847724
I don't think there's much point in having the HTA create them from the CSV....just use the code in ID: 22809117

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22847963
I thought it would be better to have an interface just to browse the file and then click on create button to run the script

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22874406
Rob,

Any luck with the HTA

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22883416
Sorry Chandru.....it's difficult to segment the difference between the csv file and hta to take data from.

The HTA code from ID: 22846176 will create single groups at a time.
The VBS code from ID: 22809117 will create multiple groups from a CSV file.

If you wanted to, in the VBS version, you could prompt for the file path to the CSV file if you didn't want to have to change the code....

Regards,

Rob.
0
 
LVL 12

Author Comment

by:chandru_sol
ID: 22883456
Thanks Rob!!

Can you help me with the below question? Not sure if you already helped Sharath with this script

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23876428.html

regards
Chandru
0

Featured Post

Enroll in May's Course of the Month

May’s Course of the Month is now available! Experts Exchange’s Premium Members and Team Accounts have access to a complimentary course each month as part of their membership—an extra way to increase training and boost professional development.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question