asked on

Looking for a script to create distribution lists and assigen them managers automatically

Hi,
i am looking for a script (vb or batch) to create many distribution list and assign them an owner in one shot.
any advise?

RobSampson

Hi, you can try this code. It has come from somewhere else, in another question, but I've modified it a bit. This will create Universal distribution groups only.

The format of your CSV file will be
universal,<groupname>,<group description>,<owner full name>

where the last three are customised by you, but the first must be "universal" without quotes.

The script will take that CSV file, no header, one group per line, and create them.

You will need to change the following:
strCSVFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "GroupsToCreate.csv"
strInternetDomain = "your.internet.domain.name"
strOU = "OU=Users,OU=Main Site,OU=Sites,"

If you set strInternetDomain to a value, the group will be mail enabled, and have an internet email address. If you set strInternetDomain to an empty string, the group will not be mail enabled.

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
 
	If strInternetDomain <> "" Then
		objGroup.mail = strGrpName & "@" & strInternetDomain
		objGroup.MailEnable
		objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strInput(1) & "@" & strInternetDomain
		objGroup.SetInfo
	End If
	
	'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

Hayes Jupe

This should help....

Const ADS_GROUP_TYPE_LOCAL_GROUP = &h2
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000

Set objOU = GetObject("LDAP://cn=users,dc=blah,dc=com")
Set objGroup = objOU.Create("Group", "cn=testgroup")

objGroup.Put "sAMAccountName", "testgroup"
objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP
objGroup.Put "ManagedBy", "CN=JoeBloggs,OU=Users,DC=BLAH,DC=COM"

objGroup.SetInfo

Hayes Jupe

sorry, other guy posted while i was writing - his is far more complete....

RobSampson

Oh, line 49 in the above code is incorrect.....please change thie line:
objGroup.sAMAccountName = Right(strInput(1),Len(StrInput(1))-1)

to this
objGroup.sAMAccountName = strInput(1)

Regards,

Rob.

johnnyjonathan

ASKER

Hi,
thanks for both of you.
i am having a problem with Rob's script, i'm getting an error saying "there is no such object on the server".

i have changed the

strou = to the OU where i want the lists created, it's full DN.
though i'm not sure exactly regarding the srtCSVFILE, am i only suppose to modify it's name according to my csv file?

RobSampson

Hi, with strCSVFile, you only need to change the file name *IF* the file is in the same folder as the VBS file.

Otherwise, make it something like
strCSVFile = "C:\Temp\GroupsToCreate.csv"

With strOU, you don't need to add your DC=Domain,DC=Com part to it.

For example
strOU = "OU=Users,OU=Main Site,OU=Sites,"

refers, in my domain, to
domain.com/Sites/Main Site/Users

Notice that you need to specify the OU path in reverse order in strOU.

Regards,

Rob.

Steynsk

May be this helps:

I've got other versions to.

Like one that writes to MSSQL or Access or Outlook.

Steynsk

'\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\
'\\    Filter AD groups, select a AD group and make a list of its users
'\\    Frans Erich  16-02-06
'\\
'\\		 Sub :  CheckForUser and GetUserAccount taken from "ADuser" script from Ralph E Montgomery 
'\\		 Function :  SelectBox taken from script from T. Lavedas
'\\    
'\\    Script only works in a domain environment
'\\
'\\\\\\\\\\\\\\\\\\\\\\\
'On Error Resume Next
Dim objGroup, objUser, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, Ouser, fso
Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount
 
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
strRootDSE = objRootDSE.Get("defaultNamingContext")
strDomain = UCase(objNet.UserDomain)
strSearch = LCase(InputBox("Geef een optionele waarde op waarop u groepen wilt filteren."))
ListGroups( strDomain )
intOpt = 1
'input validation
sGroup = SelectBox("Selecteer een groep", aOpt)
If sGroup = "Selecteer een groep" Then
	strMessage ="U heeft geen keuze gemaakt uit één van de aangeboden groepen."
	Cancelled()
End If
	
' Change the value of variable "strFormat"  beneath to "Outlook" to generate a new mail containing all email addresses of the mebers in the BCC box.
strFormat = "Excel"
 
Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
if sgroup <> "Aborted" then
     if sgroup <> "Selecteer een groep" then
            if strFormat = "Excel" then
                 strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
                 strFile = strTemp & "\Ledenlijst " & sgroup & ".csv"
                Set fso = CreateObject("Scripting.FileSystemObject")
              If fso.FileExists(strFile) Then
               fso.DeleteFile(strFile)
              End If 
               Set txtFile = fso.CreateTextFile(strFile)
               i = 0
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()
               	   GetUserAccount(strDN)
               else
               	   strMail = "computer account"
               	   strDisplayDepartment = "computer account"
        	   end if
               txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
               Next
               txtfile.close
               Set txtfile = nothing
               Set fso = nothing
               strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
               If KeyExists(strKey) = True Then
                    strKeyValue = WshShell.RegRead(strKey)
                    rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,TRUE) 
               else
                    rval = WshShell.Run("notepad.exe" & " " & strFile,1,TRUE)               
               end if
          else
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()        	   
               	   GetUserAccount(strDN)
               end if
               strBCC = strBCC & strMail &"; " 
               Next
               Set oMailApp = CreateObject("Outlook.Application")
               Set olMailItm = oMailApp.CreateItem(olMailItem)
               olMailItm.BCC = strBCC
               olMailItm.Display
          end if
     end if 
end if
 
Sub CheckForUser()
     Set objConnection = CreateObject("ADODB.Connection")
     objConnection.Provider = ("ADsDSOObject")
     objConnection.Open
     Set objCommand = CreateObject("ADODB.Command")
     objCommand.ActiveConnection = objConnection
     objCommand.CommandText = _
     "<LDAP://" & strRootDSE & ">;(&(objectCategory=user)" & _
     "(samAccountName=" & strGetUserName & "));distinguishedName,sAMAccountName,name;subtree"
     Set objRecordSet = objCommand.Execute
     strDN = objRecordset.Fields("distinguishedName") 
     Set objectRecordSet = Nothing
     objConnection.close
     Set objConnection = Nothing
End Sub
 
Sub GetUserAccount(strDN)
    On Error Resume Next
    If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
    Set objUser = GetObject("LDAP://" & strDN & "")
    Set objAdS = GetObject("LDAP://" & strRootDSE & "")
 
    With objUser
        '.GetInfo
        strMail =        .Get("mail")
        strLogonName =   .Get("sAMAccountName")
        strUserMail =    .Get("mail")
        strDescription = .GetEx("description")
        strDepartment =  .GetEx("department")
 
        strDisplayDepartment=""
        For Each strValue in strDepartment
         strDisplayDepartment = strDisplayDepartment & strValue
        Next
    
        For Each strValue in strDescription
         strDisplayDescription = strDisplayDescription & strValue
        Next
  
    End With
    
End Sub
 
Sub ListGroups( strDomain )
    Set objComputer = GetObject("WinNT://" & strDomain )
    objComputer.Filter = Array( "Group" )
    For Each objGroup In objComputer
    gt = objGroup.groupType
    if (InStr(LCase(objGroup.Name),strSearch) and (gt = &h02)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h01)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h08))  then
         ReDim Preserve aOpt(intOpt+ 1)
          aOpt(intOpt) = objGroup.Name
          intOpt = intOpt + 1
     end if
    Next
    If intOpt = 0 then
    strMessage ="Uw zoekopdracht heeft geen resultaat opgeleverd."
	Cancelled()
	end if
End Sub
 
Function SelectBox(sTitle, aOptions)
  Dim oIE, s, item
  set oIE = CreateObject("InternetExplorer.Application")
  With oIE
    .FullScreen = True
    .ToolBar   = False : .RegisterAsDropTarget = False
    .StatusBar = False : .Navigate("about:blank")
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
    .width= 400 : .height=200
    With .document
      with .parentWindow.screen
        oIE.left = (.availWidth  - oIE.width ) \ 2
        oIE.top  = (.availheight - oIE.height) \ 2
      End With
      s = "<html><head><title>" & sTitle _
        & "</title></head><script language=vbs>bWait=true<" & "/script>" _
        & "<body bgColor=Silver><center>" _
	& "<b>" & sTitle & "<b><p>" _
        & "<select id=entries size=1 style='width:325px'>" _
        & "  <option selected>" & sTitle & "</option>"
      For each item in aOptions
        s = s & "  <option>" & item & "</option>"
      Next
      s = s & "  </select><p>" _
        & "<button id=but0 onclick='bWait=false'>OK</button>" _
        & "<br><br><span style=" & chr(34)& "font-size: 8pt" & chr(34)& "><A HREF=" & chr(34)& "mailto:scripting@erich.nu" & chr(34)& ">build by Frans Erich</A></span>" _
        & "</center></body></html>"
      .open
      .Write(s)
      .close
      Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
      With .body
        .scroll="no"
        .style.borderStyle = "outset"
        .style.borderWidth = "3px"
      End With
      .all.entries.focus
      oIE.Visible = True
      CreateObject("Wscript.Shell").AppActivate sTitle
      On Error Resume Next
      Do While .ParentWindow.bWait
        WScript.Sleep 100
        if oIE.Visible Then SelectBox = "Aborted"
        if Err.Number <> 0 Then Exit Function
      Loop
      On Error Goto 0
      With .ParentWindow.entries
        SelectBox = .options(.selectedIndex).text
      End With
    End With
    .Visible = False
  End With
End Function
 
 
Function KeyExists(sKeyPath)
     keyExists= false: if (sKeyPath="") then exit function
     on error resume next
     createobject("wscript.shell").regRead sKeyPath
     select case err
     case 0: keyExists= true
     case &h80070002: dim sErrMsg
     sErrMsg= replace(err.description, sKeyPath, "")
     err.clear
     createobject("wscript.shell").regRead "HKEY_ERROR\"
     keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
     case else: keyExists= false
     end select
     on error goto 0
End function
Sub Cancelled()
    strTitle = "Einde script"
    MsgBox strMessage,vbOkOnly,strTitle
    WScript.quit
End Sub 'Cancelled

Open in new window

johnnyjonathan

ASKER

Thanks for the explenation Rob, i'm now getting the following error:
object doesn't support this property or method: 'objgroup.mailenable'
yet the distribuiton list is created but the manager isn't added.
i tried fast name - last name AND last name - first name.
any ideas?

RobSampson

OK, try setting
strInternetDomain
to just an empty string, so that line 13 is just
strInternetDomain = ""

This will not attempt to mailenable the distribution group. I cannot do this in my domain as I do not have Exchange, so perhaps you cannot mail enable groups either....

The manager is added after the mail enabling, so once we skip that bit, the manager should be added.

Regards,

Rob.

johnnyjonathan

ASKER

Tried it,
the list is created, still no manager. and i get the following error:
"either bof or eof is true, or the current record has been deleted, requested operation requires a current record."

in the owner name, i should try last name and then first name, correct?
what else could cause this?

RobSampson

>> n the owner name, i should try last name and then first name, correct?
No, it is the full name of the owner, as in Firstname Lastname (or the displayname).

Try that....also, comment out line 64, which is this:
objRecordSet2.MoveFirst

that should not be required....

Regards,

Rob.

johnnyjonathan

ASKER

OK,
well now the scripts runs with no errors.
however still no manager listed. i've tried as you have told me.
in addition, is there no way to make them mail enabled?

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Hayes Jupe

yep, in order to use object.mailenable, you must have the exchange tools installed also.

johnnyjonathan

ASKER

Wonderful, it works! thank you,
and i do have exchange integrated in my domain, the question is what i need to input in the script to make it work?

RobSampson

Well, in theory, then you should be able to manually mail enable the group, and then, in theory, objGroup.mailenable should work, but you appear to be getting
object doesn't support this property or method: 'objgroup.mailenable'

which is strange. You can make strInternetDomain equal to your domain name again, and see if it sets the mailenable....

Otherwise I'll have to look into it. Do you have Exchange Administration Tools installed on the computer / server that you're running this script from?

Regards,

Rob.

johnnyjonathan

ASKER

when your saying my domain name, if it's microsoft then do i simply write microsoft or microsoft.com or it's full CN?

RobSampson

I believe it should be whatever your mail domain is, such as microsoft.com

Regards,

Rob.

johnnyjonathan

ASKER

tried it, it doesn't help.
is there anything i'm missing?

johnnyjonathan

ASKER

I found this script online.
anything we can use from here?

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

RobSampson

That is the same script.....

If you're getting this error
object doesn't support this property or method: 'objgroup.mailenable'

there must be something wrong with your mail integration? Can you mail enable them manually?

Rob.

johnnyjonathan

ASKER

i can.
and i'm not getting any error the groups are simply not mail enabled.
Sorry for being such a nag but this is new territory for me, the script i added though i understand is the same one in basics has diffrent values.
it does not use the strInternetDomain valubal but rather uses:

'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"

prehaps there is another method?

RobSampson

That's essentially the same thing...in the script I posted, there is this:
            objGroup.mail = strGrpName & "@" & strInternetDomain
            objGroup.MailEnable
            objGroup.Put "ProxyAddresses", "SMTP:" & "##-" & strInput(1) & "@" & strInternetDomain
            objGroup.SetInfo

where strInternetDomain is just replacing ".yourdomain.com"

Perhaps you can try adding this
            objGroup.SetInfo

underneath this line
            objGroup.MailEnable

so that immediately after mail enabling, it sets the configuration, *then* adds a proxy address, and sets the configuration again.

Don't forget you need to have
strInternetDomain equal to something for that block to execute.

Regards,

Rob.

johnnyjonathan

ASKER

did it and got the same results, group is created OK but no exchange tabs

johnnyjonathan

ASKER

Rob, again thank you for your help on this, your a real pro