Solved

vbscript for distribution groups

Posted on 2008-10-15
30
1,147 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
  • 17
  • 13
30 Comments
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
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
Comment Utility
Rob,

HTA with input from CSV can be achieved

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
Hi Rob,

Any luck with the HTA

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
Hi Rob,

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

regards
Chandru
0
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
0
 
LVL 12

Author Comment

by:chandru_sol
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
>> 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Rob,

Any luck with the HTA

regards
Chandru
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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
Comment Utility
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Unlike scripting languages such as C# where a semi-colon is used to indicate the end of a command, Microsoft's VBScript language relies on line breaks to determine when a command begins and ends. As you can imagine, this quickly results in messy cod…
This is an addendum to the following article: Acitve Directory based Outlook Signature (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24950055.html) The script is fine, and works in normal client-server domains…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

743 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now