Query: How To Create Recipient Policies Programmatically

Query: How To Create Recipient Policies Programmatically

Post by Chris Wes » Thu, 08 Mar 2001 14:08:56



All,

Can't seem to find any code to create a Recipient Policy in Exchange 2000.
Does anyone have any code they could post to help me along ?

Thanks !

Rgds
Chris

 
 
 

Query: How To Create Recipient Policies Programmatically

Post by Chris Wes » Fri, 09 Mar 2001 11:40:48


All,

Figured it out. Thought I would post my two routines: One creates a Policy
and the other deletes a Policy.

Written for use in a VB DLL. It will need references to both ActiveDS and
ADO.

Rgds
Chris

' To use

'    CreateRecipientPolicy "bugbug", "bugbug.com"

'    DeleteRecipientPolicy "bugbug"

Function CreateRecipientPolicy(ByVal strPolicyName As String, ByVal
strSMTPDomain As String) As String

    Dim objRootDSE          As ActiveDs.IADs
    Dim objRecpDefault      As ActiveDs.IADs
    Dim objRecpContainer    As ActiveDs.IADs
    Dim objRecp             As ActiveDs.IADs
    Dim objNewRecp          As ActiveDs.IADs
    Dim cnnAD               As ADODB.Connection
    Dim cmdAD               As ADODB.Command
    Dim rstAD               As ADODB.Recordset
    Dim strConfigNC         As String
    Dim strQuery            As String
    Dim strOrg              As String
    Dim lngPolicyOrder      As Long
    Dim lngValue            As Long

    ' Create the ADO objects we are going to use
    Set cnnAD = CreateObject("ADODB.Connection")
    Set cmdAD = CreateObject("ADODB.Command")

    ' Get the Configuration Naming Context
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strConfigNC = objRootDSE.Get("configurationNamingContext")

    ' Open the Connection
    cnnAD.Provider = "ADsDSOObject"
    cnnAD.Open "ADs Provider"

    ' Build the query to find the Organization
    strQuery = "<LDAP://" & strConfigNC &
">;(objectCategory=msExchOrganizationContainer);name,cn,distinguishedName;su
btree"

    ' Execure the query
    cmdAD.ActiveConnection = cnnAD
    cmdAD.CommandText = strQuery
    Set rstAD = cmdAD.Execute

    ' Do we have a record ?
    If rstAD.EOF Then
        ' No, raise Error
        Err.Raise 16000
    End If

    ' Store the Organisation name
    strOrg = rstAD.Fields("cn")

    ' Close the ADO objects
    rstAD.Close
    cnnAD.Close

    ' Get a reference to the default Recipient Policy for later use
    Set objRecpDefault = GetObject("LDAP://cn=Default Policy,cn=Recipient
Policies," & "cn=" & strOrg & ",CN=Microsoft Exchange,CN=Services," &
strConfigNC)

    ' Get a reference to the Recipient Policy container
    Set objRecpContainer = GetObject("LDAP://cn=Recipient Policies," & "cn="
& strOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigNC)

    ' Get the highest policy order (in numberic terms the highest number)
    lngPolicyOrder = 0
    For Each objRecp In objRecpContainer
        Debug.Print objRecp.Get("cn")
        lngValue = objRecp.Get("msExchpolicyOrder")
        If lngValue > lngPolicyOrder Then
            If lngValue <> &H7FFFFFFF Then
                lngPolicyOrder = lngValue
            End If
        End If
    Next

    ' Increment this value by on for assignment to the new Policy
    lngPolicyOrder = lngPolicyOrder + 1

    ' Create the new Policy
    Set objNewRecp = objRecpContainer.Create("msExchRecipientPolicy", "cn="
& strPolicyName)

    ' Assign default values from the Default Policy
    objNewRecp.Put "systemFlags", objRecpDefault.Get("systemFlags")
'    objNewRecp.Put "disabledGatewayProxy",
objRecpDefault.Get("disabledGatewayProxy")
    objNewRecp.Put "msExchPolicyOptionList",
objRecpDefault.Get("msExchPolicyOptionList")
    objNewRecp.Put "msExchpolicyOrder", lngPolicyOrder

    ' Set other values for the new Policy
    objNewRecp.Put "msExchProxyGenOptions", 0

    ' Commit the policy to the AD
    objNewRecp.SetInfo

    ' Garbase collection
    Set rstAD = Nothing
    Set cmdAD = Nothing
    Set cnnAD = Nothing
    Set objNewRecp = Nothing
    Set objRecp = Nothing
    Set objRecpContainer = Nothing
    Set objRecpDefault = Nothing
    Set objRootDSE = Nothing

End Function

Function DeleteRecipientPolicy(ByVal strPolicyName As String) As String

    Dim objRootDSE          As ActiveDs.IADs
    Dim objRecpContainer    As ActiveDs.IADsContainer
    Dim cnnAD               As ADODB.Connection
    Dim cmdAD               As ADODB.Command
    Dim rstAD               As ADODB.Recordset
    Dim strConfigNC         As String
    Dim strQuery            As String
    Dim strOrg              As String
    Dim lngPolicyOrder      As Long
    Dim lngValue            As Long

    ' Create the ADO objects we are going to use
    Set cnnAD = CreateObject("ADODB.Connection")
    Set cmdAD = CreateObject("ADODB.Command")

    ' Get the Configuration Naming Context
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strConfigNC = objRootDSE.Get("configurationNamingContext")

    ' Open the Connection
    cnnAD.Provider = "ADsDSOObject"
    cnnAD.Open "ADs Provider"

    ' Build the query to find the Organization
    strQuery = "<LDAP://" & strConfigNC &
">;(objectCategory=msExchOrganizationContainer);name,cn,distinguishedName;su
btree"

    ' Execure the query
    cmdAD.ActiveConnection = cnnAD
    cmdAD.CommandText = strQuery
    Set rstAD = cmdAD.Execute

    ' Do we have a record ?
    If rstAD.EOF Then
        ' TODO No, raise Error
        Err.Raise 16000
    End If

    ' Store the Organisation name
    strOrg = rstAD.Fields("cn")

    ' Close the ADO objects
    rstAD.Close
    cnnAD.Close

    ' Get a reference to the Recipient Policy container
    Set objRecpContainer = GetObject("LDAP://cn=Recipient Policies," & "cn="
& strOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigNC)

    ' Delete the Recipient
    objRecpContainer.Delete "msExchRecipientPolicy", "cn=" & strPolicyName

    ' Garbage collection
    Set rstAD = Nothing
    Set cmdAD = Nothing
    Set cnnAD = Nothing
    Set objRootDSE = Nothing
    Set objRecpContainer = Nothing

End Function

 
 
 

Query: How To Create Recipient Policies Programmatically

Post by Chris Wes » Fri, 09 Mar 2001 13:06:08


Also, have not added the LDAP Filter Rules in the Create.

"Chris West" <Ch...@NOSPAM.atp.co.nz> wrote in message

news:uuvqwk3pAHA.1304@tkmsftngp05...
> All,

> Figured it out. Thought I would post my two routines: One creates a Policy
> and the other deletes a Policy.

> Written for use in a VB DLL. It will need references to both ActiveDS and
> ADO.

> Rgds
> Chris

> ' To use

> '    CreateRecipientPolicy "bugbug", "bugbug.com"

> '    DeleteRecipientPolicy "bugbug"

> Function CreateRecipientPolicy(ByVal strPolicyName As String, ByVal
> strSMTPDomain As String) As String

>     Dim objRootDSE          As ActiveDs.IADs
>     Dim objRecpDefault      As ActiveDs.IADs
>     Dim objRecpContainer    As ActiveDs.IADs
>     Dim objRecp             As ActiveDs.IADs
>     Dim objNewRecp          As ActiveDs.IADs
>     Dim cnnAD               As ADODB.Connection
>     Dim cmdAD               As ADODB.Command
>     Dim rstAD               As ADODB.Recordset
>     Dim strConfigNC         As String
>     Dim strQuery            As String
>     Dim strOrg              As String
>     Dim lngPolicyOrder      As Long
>     Dim lngValue            As Long

>     ' Create the ADO objects we are going to use
>     Set cnnAD = CreateObject("ADODB.Connection")
>     Set cmdAD = CreateObject("ADODB.Command")

>     ' Get the Configuration Naming Context
>     Set objRootDSE = GetObject("LDAP://RootDSE")
>     strConfigNC = objRootDSE.Get("configurationNamingContext")

>     ' Open the Connection
>     cnnAD.Provider = "ADsDSOObject"
>     cnnAD.Open "ADs Provider"

>     ' Build the query to find the Organization
>     strQuery = "<LDAP://" & strConfigNC &

">;(objectCategory=msExchOrganizationContainer);name,cn,distinguishedName;su

- Show quoted text -

> btree"

>     ' Execure the query
>     cmdAD.ActiveConnection = cnnAD
>     cmdAD.CommandText = strQuery
>     Set rstAD = cmdAD.Execute

>     ' Do we have a record ?
>     If rstAD.EOF Then
>         ' No, raise Error
>         Err.Raise 16000
>     End If

>     ' Store the Organisation name
>     strOrg = rstAD.Fields("cn")

>     ' Close the ADO objects
>     rstAD.Close
>     cnnAD.Close

>     ' Get a reference to the default Recipient Policy for later use
>     Set objRecpDefault = GetObject("LDAP://cn=Default Policy,cn=Recipient
> Policies," & "cn=" & strOrg & ",CN=Microsoft Exchange,CN=Services," &
> strConfigNC)

>     ' Get a reference to the Recipient Policy container
>     Set objRecpContainer = GetObject("LDAP://cn=Recipient Policies," &
"cn="
> & strOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigNC)

>     ' Get the highest policy order (in numberic terms the highest number)
>     lngPolicyOrder = 0
>     For Each objRecp In objRecpContainer
>         Debug.Print objRecp.Get("cn")
>         lngValue = objRecp.Get("msExchpolicyOrder")
>         If lngValue > lngPolicyOrder Then
>             If lngValue <> &H7FFFFFFF Then
>                 lngPolicyOrder = lngValue
>             End If
>         End If
>     Next

>     ' Increment this value by on for assignment to the new Policy
>     lngPolicyOrder = lngPolicyOrder + 1

>     ' Create the new Policy
>     Set objNewRecp = objRecpContainer.Create("msExchRecipientPolicy",
"cn="
> & strPolicyName)

>     ' Assign default values from the Default Policy
>     objNewRecp.Put "systemFlags", objRecpDefault.Get("systemFlags")
> '    objNewRecp.Put "disabledGatewayProxy",
> objRecpDefault.Get("disabledGatewayProxy")
>     objNewRecp.Put "msExchPolicyOptionList",
> objRecpDefault.Get("msExchPolicyOptionList")
>     objNewRecp.Put "msExchpolicyOrder", lngPolicyOrder

>     ' Set other values for the new Policy
>     objNewRecp.Put "msExchProxyGenOptions", 0
>     objNewRecp.Put "GatewayProxy", Array("SMTP:@" & strSMTPDomain)

>     ' Commit the policy to the AD
>     objNewRecp.SetInfo

>     ' Garbase collection
>     Set rstAD = Nothing
>     Set cmdAD = Nothing
>     Set cnnAD = Nothing
>     Set objNewRecp = Nothing
>     Set objRecp = Nothing
>     Set objRecpContainer = Nothing
>     Set objRecpDefault = Nothing
>     Set objRootDSE = Nothing

> End Function

> Function DeleteRecipientPolicy(ByVal strPolicyName As String) As String

>     Dim objRootDSE          As ActiveDs.IADs
>     Dim objRecpContainer    As ActiveDs.IADsContainer
>     Dim cnnAD               As ADODB.Connection
>     Dim cmdAD               As ADODB.Command
>     Dim rstAD               As ADODB.Recordset
>     Dim strConfigNC         As String
>     Dim strQuery            As String
>     Dim strOrg              As String
>     Dim lngPolicyOrder      As Long
>     Dim lngValue            As Long

>     ' Create the ADO objects we are going to use
>     Set cnnAD = CreateObject("ADODB.Connection")
>     Set cmdAD = CreateObject("ADODB.Command")

>     ' Get the Configuration Naming Context
>     Set objRootDSE = GetObject("LDAP://RootDSE")
>     strConfigNC = objRootDSE.Get("configurationNamingContext")

>     ' Open the Connection
>     cnnAD.Provider = "ADsDSOObject"
>     cnnAD.Open "ADs Provider"

>     ' Build the query to find the Organization
>     strQuery = "<LDAP://" & strConfigNC &

">;(objectCategory=msExchOrganizationContainer);name,cn,distinguishedName;su

- Show quoted text -

> btree"

>     ' Execure the query
>     cmdAD.ActiveConnection = cnnAD
>     cmdAD.CommandText = strQuery
>     Set rstAD = cmdAD.Execute

>     ' Do we have a record ?
>     If rstAD.EOF Then
>         ' TODO No, raise Error
>         Err.Raise 16000
>     End If

>     ' Store the Organisation name
>     strOrg = rstAD.Fields("cn")

>     ' Close the ADO objects
>     rstAD.Close
>     cnnAD.Close

>     ' Get a reference to the Recipient Policy container
>     Set objRecpContainer = GetObject("LDAP://cn=Recipient Policies," &
"cn="
> & strOrg & ",CN=Microsoft Exchange,CN=Services," & strConfigNC)

>     ' Delete the Recipient
>     objRecpContainer.Delete "msExchRecipientPolicy", "cn=" & strPolicyName

>     ' Garbage collection
>     Set rstAD = Nothing
>     Set cmdAD = Nothing
>     Set cnnAD = Nothing
>     Set objRootDSE = Nothing
>     Set objRecpContainer = Nothing

> End Function

 
 
 

1. HOWTO Programmatically Create a Recipient Policy?

Hi!

Which properies do i have to set on a msExchRecipientPolicy in order to get
the Recipent Update Service to use the policy when generating addresses?

I have made a application that sets the following properties on the new
object:

Set obj = cntr.Create("msExchRecipientPolicy", "cn="PolicyName")
in container
/cn=Recipient Policies,cn=Org,cn=Microsoft
Exchange,cn=Services,cn=Configuration,dc=lab,dc=mydomain,dc=com"

    - "purportedSearch"
    - "msExchPolicyOrder"
    - "msExchPolicyOptionList"
    - "systemFlags"
    - "gatewayProxy"
    - "msExchPurportedSearchUI"

When I go into Exchange System Mangager and open the policy I
programmatically created, and press MODIFY and FIND NOW, the users that
matches the filter specified in "purportedSearch" show up, so the LDAP-
filter is working.

The mail address specified in "gatewayProxy" is not applied to the user
object.

What am I doing wrong? Do I have to manipulate objects other than
msExchRecipientPolicy?
Any help or hints would be helpful!
Thanks!

Regards,
Haakon

2. changing Internet domain name in Exchange 2000

3. Programmatically Creating Recipient Policies

4. Outlook 97 Won't Synchronize

5. Programmatically add new domain to defualt recipient policy

6. Advance admins pls help - mssearch on exchange server

7. Recipient policy with ldap query on DistinguishedName

8. benchmark tool,Exchange 5.5

9. Recipient Policy Custom Query

10. Recipient Policy LDAP Query

11. LDAP Recipient Policy custom Query DistinguishedName

12. ldap query in recipient policy appends (&

13. Programatically creating Recipient Policies