Creating a Recipient Policy

Article
08/20/2015
Creating a Recipient Policy

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.
The following example creates a new recipient policy.
Visual Basic

'//////////////////////////////////////////////////////////////////////
' Function: createRecipientPolicy()
' Purpose:  Creates a new recipient policy.
'
' Input:    szDomainName:         Domain of the exchange organization
'           szOrganizationName:   Name of the exchange organization
'           szPolicyName:         Name of the policy
'           szPolicyOrder:        Order of the policy
'           szDomain:             Domain of the hosted org
'           szUserName:           Admin username
'           szUserPwd:            Admin pwd
'           szDirectoryServer:    Name of the Directory Server
'
' Output:   createRecipientPolicy:   Contains Error code (if any)
'
' Note:  In order for this example to function correctly, it may be necessary to include
' references to the following libraries: Active DS Type Library, Microsoft CDO for
' Exchange Management Library, Microsoft Cluster Service Automation Classes,
' Microsoft CDO for Windows 2000 Library.
'//////////////////////////////////////////////////////////////////////
Public Function createRecipientPolicy(szDomainName As String, _
                                      szOrganizationName As String, _
                                      szPolicyName As String, _
                                      szPolicyOrder As String, _
                                      szDomain As String, _
                                      szUserName As String, _
                                      szUserPwd As String, _
                                      ByVal szDirectoryServer) As Integer

    Dim objLdap As IADsOpenDSObject
    Dim objPolicy As IADs
    Dim objPolicyContainer As IADsContainer
    Dim szConnString As String
    Dim szSearchRequest As String
    Dim baOptList(15) As Byte
    Dim iPolicyOrder As Integer
    Dim szaDomTokens() As String
    Dim szDomainDN As String

    On Error GoTo errhandler

    'Make the byte array
    baOptList(0) = 252
    baOptList(1) = 28
    baOptList(2) = 73
    baOptList(3) = 38
    baOptList(4) = 80
    baOptList(5) = 158
    baOptList(6) = 87
    baOptList(7) = 72
    baOptList(8) = 134
    baOptList(9) = 27
    baOptList(10) = 12
    baOptList(11) = 184
    baOptList(12) = 223
    baOptList(13) = 34
    baOptList(14) = 181
    baOptList(15) = 215

    ' Put the domain name into an ldap string
    szaDomTokens = Split(szDomainName, ".", -1, 1)
    szDomainDN = Join(szaDomTokens, ",dc=")
    szDomainDN = "dc=" & szDomainDN

    ' Build the ldap connection string.
    szConnString = "LDAP://" + szDirectoryServer + "/" + _
                 "cn=Recipient Policies,cn=" + szOrganizationName + _
                 ",cn=microsoft exchange,cn=services,cn=configuration," + szDomainDN

    ' This search request creates a recipient policy that does both users and groups.

    szSearchRequest = "(|(&(&(&(|(&(objectCategory=person)(objectSid=*)(!samAccountType:1.2.840.113556.1.4.804:=3))(&(objectCategory=person)(!objectSid=*))(&(objectCategory=group)(groupType:1.2.840.113556.1.4.804:=14))))(objectClass=user)(userPrincipalName=*" + szDomain + ")))"
    szSearchRequest = szSearchRequest + "(&(&(&(&(mailnickname=*)(|(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=contact))(objectCategory=group)(objectCategory=publicFolder))))(objectCategory=group)(displayName=*" + szDomain + "))))"


    ' Open up the directory with the passed credentials (preferably the admin).

    Set objLdap = GetObject("LDAP:")

    ' Get a container object from the connection string.

    Set objPolicyContainer = objLdap.OpenDSObject(szConnString, _
                                                  szUserName, _
                                                  szUserPwd, _
                                                  ADS_SECURE_AUTHENTICATION)

    ' Create the recipient policy object.

    Set objPolicy = objPolicyContainer.Create("msExchRecipientPolicy", _
                                              "cn=" + szPolicyName)

    ' Required properties.

    With objPolicy
        .Put "purportedSearch", szSearchRequest
        .Put "showInAdvancedViewOnly", True
        .Put "systemFlags", 1610612736
        .Put "gatewayProxy", Array("SMTP:@" + szDomain, "X400:c=us;a= ;p=" + Mid(szOrganizationName, 1, 16) + ";o=Exchange;")
        .Put "msExchPurportedSearchUI", Array("Microsoft.PropertyWell_Value0=" + szDomain, "Microsoft.PropertyWell_Condition0=5", "Microsoft.PropertyWell_Property0=userPrincipalName", "Microsoft.PropertyWell_ObjectClass0=user", "Microsoft.PropertyWell_Items=1", "Exchange_ObjectTypes=0", "DsQuery_EnableFilter=0", "DsQuery_ViewMode=4868", "CommonQuery_Form=E23FEE83D957D011B93200A024AB2DBB", "CommonQuery_Handler=5EE6238AC231D011891C00A024AB2DBB")
        .Put "msExchPolicyOptionList", baOptList
        iPolicyOrder = Int(Val(szPolicyOrder))
        .Put "msExchPolicyOrder", iPolicyOrder
        .SetInfo
    End With

    createRecipientPolicy = 0

    ' Clean up.
    Set objLdap = Nothing
    Set objPolicy = Nothing
    Set objPolicyContainer = Nothing
    Exit Function

    ' Error handling.
errhandler:

    Set objLdap = Nothing
    Set objPolicy = Nothing
    Set objPolicyContainer = Nothing
    createRecipientPolicy = 1
    'Implement error logging here.

    Exit Function


End Function
Send us your feedback about the Microsoft Exchange Server 2003 SDK.
Build: June 2007 (2007.618.1)
Share via

Creating a Recipient Policy

Creating a Recipient Policy

Visual Basic

Additional resources
