'The following code creates a distribution list and populates it with
' the users found using an ADO query:
Option Explicit
Dim strDisplayName ' DL's Display name
Dim strAliasName ' DL's Alias name
Dim strDirectoryName ' DL's Directory name
Dim strUserName ' User's logon name and domain
Dim strPassword ' User's domain password
Dim strServer ' Microsoft Exchange server name
Dim strOrganization ' Microsoft Exchange Organization
Dim strSite ' Microsoft Exchange Site
Dim strRecipientsPath ' ADsPath to the Recipients Container
Dim strMSPrivMDBPath ' ADsPath to the MS Private MDB
Dim objRecipients ' Recipients Container object
Dim objMSPrivMDB ' MS Private MDB object
Dim objNewDL ' new distribution list object
Dim strMail ' mail address of the MS Private MDB object
Dim intPos ' numeric position of the '@' in an SMTP address
Dim strSMTPExt ' SMTP domain type (ie. com, org, etc...)
Dim strSMTPAddr ' new DL's SMTP address
Dim aOtherMailbox(1) ' other addresses created (ie. MSMail, CCMail)
Dim strx400Addr ' new DL's X400 address
Dim objMyIADs ' ADSI object
' used by the PutEx method to set a muti-valued property
Const ADS_PROPERTY_UPDATE = 2
strDisplayName = "BellevueDL"
strAliasName = "BellevueDL"
strDirectoryName = "BellevueDL"
strUserName = "dc=redmond, cn=v-sparke"
strPassword = "password"
strServer = "sparker1"
strOrganization = "16"
strSite = "3081"
Set objMyIADs = GetObject("LDAP:")
' The following code determines the domain address extension by
' looking at the mail property of the Microsoft Private MDB object
' (seen as Private Information Store in the Microsoft Exchange Server
' administrator program).
strMSPrivMDBPath = "LDAP://" + strServer + "/cn=Microsoft Private MDB,cn=" + strServer + ",cn=Servers ,cn=Configuration,ou=" + strSite + ",o=" + strOrganization
' The following application uses the OpenDSObject method to access
' directory objects. The user's logon domain, name, and password are
' passed as parameters. The value of 0 in the first statement means
' that the ADSI LDAP provider will do a simple bind:
Set objMSPrivMDB = objMyIADs.OpenDSObject(strMSPrivMDBPath, strUserName, strPassword, 0)
objMSPrivMDB.GetInfo
strMail = objMSPrivMDB.Get("mail")
intPos = InStr(strMail, "@")
strSMTPExt = Mid(strMail, intPos, Len(strMail))
' The following code builds SMTP, MSMAIL, CCMAIL, and X.400 addresses.
' The country identifier 'US' is hardcoded into the X.400 address. You
' can parse the textEncodedORaddress property of the Microsoft Private
' MDB object to determine the correct X.400 addressing scheme:
strSMTPAddr = replace(strAliasName, " ", "") + strSMTPExt
aOtherMailbox(0) = CStr("MS$" + strOrganization + "/" + strSite + "/" + strAliasName)
aOtherMailbox(1) = CStr("CCMAIL$" + strAliasName + " at " + strSite)
strx400Addr = "c=US;a= ;p=" + strOrganization + ";o=" + strSite + ";s=" + strAliasName + ";"
strRecipientsPath = "LDAP://" + strServer + "/cn=Recipients,ou=" + strSite + ",o=" + strOrganization
Set objRecipients = objMyIADs.OpenDSObject(strRecipientsPath, strUserName, strPassword, 0)
' The following code creates the distribution list:
' Set objNewDL = objRecipients.Create("groupOfNames", "cn=" +
' strDirectoryName)
' In VBScript, it is necessary to convert data into string values
' (using the CStr function) to properly format the data for ADSI:
objNewDL.Put "cn", CStr(strDisplayName)
objNewDL.Put "uid", CStr(strAliasName)
objNewDL.Put "distinguishedName", CStr("cn=" + strAliasName + ",cn=Recipients,ou=" + strSite + ",o=" + strOrganization)
objNewDL.Put "mail", CStr(strSMTPAddr)
' The following code creates a multi-valued property. In VBScript you
' have to de-reference the array by using parentheses:
objNewDL.PutEx ADS_PROPERTY_UPDATE, "otherMailbox", (aOtherMailbox)
objNewDL.Put "Report-To-Originator", True
objNewDL.Put "Report-to-Owner", False
objNewDL.Put "Replication-Sensitivity", CInt(20)
objNewDL.Put "rfc822Mailbox", CStr(strSMTPAddr)
objNewDL.Put "textEncodedORaddress", CStr(strx400Addr)
objNewDL.SetInfo
Response.Write "DL Created Successfully!<BR><BR>"
' The following code locates a mailbox in the Microsoft Exchange
' directory whose City (Location) property matches the search
' criteria. The ADSI LDAP name for the City property is 'l.'
Dim objADOconn ' ADO connection object
Dim strADOQueryString ' ADO query string
Dim objRS ' recordset object
Dim strCriteria ' value used to search the directory tree
strCriteria = "Bellevue"
Set objADOconn = CreateObject("ADODB.Connection")
objADOconn.Provider = "ADSDSOObject"
objADOconn.Open "ADs Provider"
strADOQueryString = "<LDAP://" + strServer + ">;(&(objectClass=organizationalPerson)(l=" + strCriteria + "));cn,adspath;subtree"
Set objRS = objADOconn.Execute(strADOQueryString)
If Not objRS.EOF Then
While Not objRS.EOF
objNewDL.Add objRS.Fields(1).Value
Response.Write objRS.Fields(0) + " added :)<BR>"
objRS.MoveNext
Wend
Else
Response.Write "No mailboxes were added to the DL :(<BR>"
End If
objRS.Close