使用此脚本可以创建已启用邮件的通讯组成生成.txt文档。
' Michael Maher 14/6/07
' Creation of mail enabled Distribution Lists from a text file.
' Must be run on a host with Exchange Server version of the Active Directory Users and Computers
' Input Boxes
strGroup = InputBox ("Input Group Name")
strEmail = InputBox ("Input Group Email Address leaving out the suffix - @company.com")
strFile = InputBox ("Input Location of a text file containing users")
' --------------------------------------------------------------------------------------------------
' Determine LDAP Domain Name
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' --------------------------------------------------------------------------------------------------
' Create the (Universal) distribution group
Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
Set objOU = GetObject("LDAP://ou=DLs,ou=Exchange Recipients," & strDNSDomain)
Set objGroup = objOU.Create("Group", "cn=" & (strGroup))
objGroup.Put "sAMAccountName", CStr(strGroup)
objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP
objGroup.Put "Name", CStr(strGroup)
objGroup.Put "DisplayName", CStr(strGroup)
'*** Hardcoded Admin Group ***
' Check an existing address in Active Directory to view your own legacy name
objGroup.Put "legacyExchangeDN", "/o=EXCHANGE/ou=IE/cn=Recipients/cn=" & strGroup
objGroup.Put "mail", CStr(strEmail)
objGroup.Put "mailNickname", CStr(strGroup)
' x400 Address required but can be set to anything if you are not actually using this addressing
objGroup.Put "proxyAddresses", Array ("X400:c=IE;a=;p=EXCHANGE;o=IE;s=" &
strEmail, "SMTP:" & CStr(strEmail) & "@company.com")
objGroup.put "targetAddress", "SMTP:" & strEmail
objGroup.SetInfo
' --------------------------------------------------------------------------------------------------
' Read the specified text file
Dim oFSO, oTS
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set oTS = oFSO.OpenTextFile (strFile)
If Err <> 0 Then
MsgBox "Couldn't open input file."
WScript.Quit
End If
On Error Goto 0
Dim strMember
Do Until oTS.AtEndOfStream
' strMember is variable used for each user in text file
strMember = oTS.ReadLine
If strMember <> "" Then
On Error Resume Next
' Use ADO to search Active Directory.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Bind to Domain through alias RootDSE
strBase = "<LDAP://" & strDNSDomain & ">"
' Get x500 Distingushed Name of each strMember
strFilter = "(&(samaccountname=" & strMember & "))"
strAttributes = "distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
If (adoRecordset.EOF = True) Then
Wscript.Echo "No duplicate display names found"
Wscript.Quit
End If
strDN = adoRecordset.Fields("distinguishedName")
Const ADS_PROPERTY_APPEND = 3
Set objGroup = GetObject("LDAP://cn=" & strGroup & ",ou=DLs,ou=Exchange Recipients" &
strDNSDomain)
' *** Hardcoded Mail Server ***
objGroup.add "LDAP://MAILSERVER001/" & strDN
objGroup.SetInfo
On Error Goto 0
End If
Loop
oTS.Close
' Cleanup Memory
Set oTS = Nothing
Set objGroup = Nothing
Set strMember = Nothing
Set strMail = Nothing
Set strFile = Nothing
Set strGroup = Nothing
