切换到宽版
  • 6216阅读
  • 0回复

[求助]使用脚本创建已启用邮件的通讯组 [复制链接]

上一主题 下一主题
 
只看楼主 倒序阅读 0楼  发表于: 2011-03-10
— 本帖被 YOYO 从 Exchange 脚本中心 移动到本区(2015-06-25) —
  • 脚本环境:Visual Basic
  • 适合版本:Exchange 2003
  • 适用平台:
使用此脚本可以创建已启用邮件的通讯组成生成.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
分享到
快速回复
限60 字节
 
上一个 下一个