CDOLive LLC The Premier Resource for Microsoft Collaboration Data Objects             


Common Tasks | Special Tasks
Tips and Tricks - Special Tasks

This tips and tricks section provides some basic and also special tasks for CDO. Note that the following examples should serve only as an idea to create your own solution and are not checked for proper function. You can find a lot of checked and proper running samples at the CDOLive Code Sample Library.

For a list of the most common MAPI property tags, please take a look at 'Digging deeper into CDO', Property Tags and Types or use the CDO.HLP file, which is located on the Microsoft Exchange Server 5.5 CD-ROM. Note, that an updated version is included with the Microsoft Exchange Server 5.5 Service Pack 1 (or higher). You can also download the most current version from CDOLive cdo.zip (1,065 Kbyte).


 

 
Special Tasks
Task Description
Read address book properties  You can retrieve all available address book properties for a specific user with CDO:
' Get reference to the current user
Set objAddressEntry = objSession.CurrentUser

' Get the MAPI properties
strCompany = objAddressEntry.Fields.Item(CdoPR_COMPANY_NAME).Value
strDepartment = objAddressEntry.Fields.Item(CdoPR_DEPARTMENT_NAME).Value

' Display properties
MsgBox strCompany
MsgBox strDepartment

  
Task Description
Read Direct Reports and Distribution List Membership There is no build-in way to access the Direct Reports and Distribution List Membership properties of an address entry. However, a custom COM object is available which can be used to access this properties with the following code:
' Create helper app COM object
Set objCollection = CreateObject("CDOLive.CDOCollection")

' Get Address entry object of selected user
Set objUser = objSession.CurrentUser

' Set it as datasource for the helper app
' to get the Direct Reports address entry collection
objCollection.DataSourceDR = objUser

' Loop through the returned recipients collection
For intCounter = 1 To objCollection.Count

  ' Pull out each recipient object
  Set objRecipient = Nothing
  On Error Resume Next
  Set objRecipient = _
   objSession.GetAddressEntry(objCollection.Item(intCounter))

  ' Check if recipient object is valid
  If Not objRecipient Is Nothing Then
    Debug.Print objRecipient.Name
  End If
Next

' Set it as datasource for the helper app
' to get the Member Of DL address entry collection
objCollection.DataSourceDL = objNewUser

' Loop through the returned recipients collection
For intCounter = 1 To objCollection.Count

  ' Pull out each recipient object
  Set objRecipient = Nothing
  On Error Resume Next
  Set objRecipient = _
    objSession.GetAddressEntry(objCollection.Item(intCounter))

  ' Check if recipient object is valid
  If Not objRecipient Is Nothing Then
    Debug.Print objRecipient.Name
  End If
Next

The helper app COM object is included with the Code Sample Library, Modify Mailbox Properties Outlook Form. Note that the source code for the helper app is not available. But you can use the Microsoft OrgChart sample (can only access the Direct Reports property), which is included with Microsoft Exchange Server 5.5, to build your own custom COM objects.
Display a custom address book dialogIt is possible to display a custom address book dialog in an Outlook form using this code:
' Create a new message
Set objRecipients = Nothing
Set objNewMessage = objSession.Outbox.Messages.Add

' Add subject
objNewMessage.Subject = "This is a message created with CDO"

' Show address book
Set objRecipients =_
objSession.AddressBook(,"Choose name:",True,,0)

' Loop through the recipients collection
For Each objRecipient In objRecipients

  ' Add each recipient to the message
  objNewMessage.Recipients.Add , , , objRecipient.ID
Next

' Resolve recipients against the Exchange directory
objNewMessage.Recipients.ResolveAll

' Send message
objNewMessage.Update
objNewMessage.Send

Detailed information about the parameters of the Session.AddressBook method is available in the CDO.HLP file, which is located on the Microsoft Exchange Server 5.5 CD-ROM.
Display a custom address book dialog without Outlook contacts or a personal address bookIn some cases you want to avoid that a user can select an entry from a particular personal address book or Outlook contact folder. To accomplish that you can use a dynamic CDO 1.x session which will give you only all Exchange Server address book container:
' Create MAPI session and get current user
objSession.Logon "", "", False, False
Set objAddressEntry = objSession.CurrentUser

' Get the home server name out of the home MTA property
strHomeServer = objAddressEntry.Fields(CdoPR_EMS_AB_HOME_MTA)
strHomeServer = Mid(strHomeServer, InStr(1, strHomeServer,_
"/cn=Configuration/cn=Servers/cn=") +_
Len("/cn=Configuration/cn=Servers/cn="),255)
strHomeServer = Left(strHomeServer, InStr(1, strHomeServer, "/") -1)

' Create a dynamic profile and logon
strProfileInfo = strNewHomeServer & Chr(10) & _
   objAddressEntry.Fields.Item(CdoPR_ACCOUNT).Value
Set objNewSession = CreateObject("MAPI.Session")
objNewSession.Logon "", ""True, False, strProfileInfo

' Show address book
Set objRecipients =_
objNewSession.AddressBook(,"Choose name:",True,,0)

' Loop through the recipients collection
For Each objRecipient In objRecipients

  MsgBox objRecipient.Name
Next

' Close dynamic MAPI session
objNewSession.Logoff

Note that the current implementation of Extended MAPI, used by CDO 1.x, exposes a memory leak that occurs each time a Session.Logon is invoked. This is documented in the Microsoft Knowledge Base and there is no fix available yet.
Check if a MAPI session is in offline mode Sometimes if you build an Outlook form solution you want prohibit a user from change an item if s/he is working in offline mode. You can check that in the form using the following code:
' MAPI property to determine if the store is in offline mode
Public Const PR_STORE_OFFLINE = &H6632000B

' Create MAPI session and logon
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, False, 0

' Get the "Public Folders" Information Store
Set objInfoStore = objSession.GetInfoStore(objSession.Inbox.StoreID)

' Check if store is in offline mode
If objInfoStore.Fields.Item(PR_STORE_OFFLINE).Value = True Then

  ' MAPI Session to an Exchange Server does not exist, show error message
  MsgBox "You cannot do that while in offline mode", 48, "Microsoft Outlook"
Else

  ' Your code here
End If

Note that this does only work if a form is published to a folder. If a form is published to a forms library you cannot use the InfoStore object to check if a connection to an Exchange Server exists.

However, here is another way to determine if a MAPI session exists with an Exchange Server:

' MAPI property tag for Exchange server message store username
Public Const CdoPR_MHS_COMMON_NAME = &H3A0F001E

' Create MAPI session and logon
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, False, 0

' Get current user object
Set objAddressEntry = objSession.CurrentUser

' Get the fields collection of the current user
Set objFields = objAddressEntry.Fields

' Get the Exchange message store username
Set objField = Nothing
On Error Resume Next
Set objField = objFields.Item(CdoPR_MHS_COMMON_NAME)

' Check if Exchange server message store username is empty
If objField Is Nothing Then

  ' MAPI Session to an Exchange server does not exist, show error message
  MsgBox "You cannot do that while in offline mode", 48, "Microsoft Outlook"
End If
Forward a message without loosing the RTF body The current implementation of the objMessage.Forward method does not copy the message body to the new message. If you try to do this within your code the message body will loose the Rich Text Format settings. You can use the following code to retain the RTF message body:
' MAPI property for RTF message body
Public Const CdoPR_RTF_COMPRESSED = &H10090102

' Get the message collection of the inbox
Set objMessages = objSession.Inbox.Messages

' Get first message
Set objMessage = objMessages.GetFirst

' Create new message
Set objFwdMessage = objMessage.Forward

' Copy the RTF message body
objFwdMessage.Fields.Add CdoPR_RTF_COMPRESSED, _
objMessage.Fields(CdoPR_RTF_COMPRESSED).Value

' Add recipient and resolve against directory
Set objRecipient = objFwdMessage.Recipients.Add
objRecipient.Name = "John Doe"
objRecipient.Resolve

' Update and send message
objFwdMessage.Update
objFwdMessage.Send

Note that his will send the message in RTF format. An e-mail client that does not understand Rich Text Format could not read the message.
Send a message with the RTF enabled flag By default it is not possible to create and send Rich Text Format (RTF) enabled messages with CDO. Here is a work around for the problem:
' Create a new message
Set objNewMessage = objSession.Outbox.Messages.Add

' Add subject
objNewMessage.Subject = "This is a RTF enabled message created with CDO"

' Add text to the message body
' Note that CDO 1.x cannot add text formatted with RTF/HTML
objNewMessage.Text = "This is a message with the RTF enabled flag"

' Add recipient name and address
' Note that the recipient address is added to the name property and also with the
' SMTP: prefix to the address property. If you not use it exactly the same way,
' you will not get a RTF enabled recipient in your message.
Set objRecipient = objNewMessage.Recipients.Add
objRecipient.Name = "JohnDoe@Domain.com"
objRecipient.Address = "SMTP:JohnDoe@Domain.com"
objRecipient.Resolve

' If you want to make sure a message is send in plain text use the following code
Set objRecipient = objNewMessage.Recipients.Add
objRecipient.Name = "JohnDoe@Domain.com"
objRecipient.Resolve

' Send message
objNewMessage.Update
objNewMessage.Send

Note that RTF enabled means that the Rich Text Format settings are retained between the originator and recipient of the message, e. g. if you want to forward a message that contains a RTF message body to another recipient via the Internet.
Access all forms published to the organization forms library The Organization Forms Library of Microsoft Exchange Server is a hidden system folder. If you want to determine which forms are published you need to access the system folder to get a (hidden) message collection of all published forms:
' MAPI property to access the system folder subtree
Public Const PR_NON_IPM_SUBTREE_ENTRYID = &H66200102

' MAPI property to access the form name
Public Const CdoPR_DISPLAY_NAME = &H3001001E

' Get the "Public Folders" information store
Set objInfoStore = objSession.InfoStores("Public Folders")

' Get the Root ID of the non IPM subtree
strRootID =_
objInfoStore.Fields.Item(PR_NON_IPM_SUBTREE_ENTRYID).Value

' Set the top folder of the non IPM subtree
Set objTopFolder = objSession.GetFolder(strRootID,objInfoStore.ID)

' Get the organization forms library
Set objFormsRegistry = objTopFolder.Folders("EFORMS REGISTRY")

' Note that you can create multiple forms libraries with different names
' This sample assumes that the name of your forms library is "Organization Forms"
Set objOrgForms = objFormsRegistry.Folders("Organization Forms")

' Once you have access to that folder, you can work with the items
Set objMessages = objOrgForms.HiddenMessages
For Each objMessage In objMessages
  MsgBox "Formname: " &_
objMessage.Fields(CdoPR_DISPLAY_NAME).Value
Next
Find a specific public folder You can use CDO to find a particular public folder. This sample find a public folder called MyFolder.
You do not need to know the name of the public information store and the root folder name if you use the following code snippet:

' MAPI property to access the public folder subtree
Public Const PR_IPM_PUBLIC_FOLDERS_ENTRYID = &H66310102

' Get InfoStore collection
Set objInfoStores = objSession.InfoStores

' Loop through the collection until we have found the public information store
' Only this infostore will return the indicated property without error
For Each objInfoStore In objInfoStores
  Err.Clear
  strRootID =_
    objInfoStore.Fields(PR_IPM_PUBLIC_FOLDERS_ENTRYID).Value

  ' Check or possible errors
  If Err.Number = 0 Then

    ' Get root folder
    Set objTopFolder = objSession.GetFolder(strRootID, objInfoStore.ID)
    Exit For
  End If
Next

' Get your folder
Set objFolder = _
objTopFolder.Folders("FirstFolder").Folders("SecondFolder").Folders("MyFolder")

' Check if we have hit the right folder
If Not objFolder Is Nothing
  ' Your code here
Else
  ' Your error checking here
End If

Once you have access to that folder, you can work with the items like you want:
Set objMessages = objFolder.Messages
Recursively find a specific folder If you need to recursively find a folder in the folder hierarchy and you don't have the folder ID, you can use the following Microsoft Visual Basic code snippet to walk recursively  through the hierarchy:
Function ListFolders(objFolder)
If Not objFolder Is Nothing Then

  ' Display folder name
  MsgBox ("Folder name = " & objFolder.Name)

  ' Get folders collection of the folder
  Set objFoldersColl = objFolder.Folders

  ' Check if folders collection is not empty
  If Not objFoldersColl Is Nothing Then

    ' Get first folder
    Set objOneSubfolder = objFoldersColl.GetFirst

    ' Loop through the folders collection
    While Not objOneSubfolder Is Nothing

      ' Get next folder
      ListFolders(objOneSubfolder)
      Set objOneSubfolder = objFoldersColl.GetNext
    Wend
  End If
End If
End Function
Read folder permissions You can use CDO to read the permissions of a particular folder. But you cannot modify folder permissions, though:
' Set folder
Set objFolder = objSession.Inbox

' Folder permissions MAPI property
Public Const CdoPR_ACCESS = &H0FF40003

' Folder permission levels
strFolderAccess = objFolder.Fields(CdoPR_ACCESS)
Public Const MAPI_ACCESS_READ =_
strFolderAccess AND &H00000002
Public Const MAPI_ACCESS_DELETE =_
strFolderAccess AND &H00000004
Public Const MAPI_ACCESS_CREATE_CONTENTS =_
strFolderAccess AND &H00000001
Public Const MAPI_ACCESS_CREATE_HIERARCHY =_
strFolderAccess AND &H00000008

' Check the permissions of the folder
If MAPI_ACCESS_READ <> 0 Then
  ' Permission to read items
End If
If MAPI_ACCESS_DELETE <> 0 Then
  ' Permission to delete items
End If
If MAPI_ACCESS_CREATE_CONTENTS <> 0 Then
  ' Permission to create items
End If
If MAPI_ACCESS_CREATE_HIERARCHY <> 0 Then
  ' Permission to create subfolders
End If
Get the top level of the private information store In some cases you need to get the top level of the private information store. For example if you want to create a new folder on the same level as, say, the inbox. In this case you need to obtain the private information store and get the root folder. To avoid language conflicts you can use the following code:
' Get inbox of current session
Set objInbox = objSession.Inbox

' Get private infostore
Set objInfostore = objSession.GetInfoStore(objInbox.StoreID)

' Get root folder
Set objRootFolder = objInfoStore.RootFolder

' Get folders collection
Set objFolders = objRootFolder.Folders

' Add your folder
Set objFolder = objFolder.Add("MyFolder")
Determine the folder type Microsoft Outlook added the ability to have several different folder types, e.g. Calendars, Contacts etc. The information used to determine the folder type is stored in a single MAPI property if it is not a mail folder:
' MAPI properties used
Const CdoPR_CONTAINER_CLASS = &H3613001E

' Get default calendar folder
Set objFolder = onjSession.GetDefaultFolder(CdoDefaultFolderCalendar)

' Get fields collection
Set objFields = objFolder.Fields

' Get folder type field
Set objField = objFields.Item(CdoPR_CONTAINER_CLASS)

' Display folder type
MsgBox objField.Value

For a list of possible values please take a look at 'Digging deeper into CDO', Property Tags and Types 

Note that the Inbox, Outbox, Sent Items and all other mail folders do not expose this property. To distinguish between them you need to use the MAPI properties as described in the CDO documentation and CDO.HLP.
Open another users calendar folder While the Outlook object model provides a GetSharedDefaultFolder method to open folders of another users mailbox CDO 1.x doesn't have such a method. However, you can use two different methods to access other users folders. assuming you want to open the calendar folder use one of the following methods:
1. Add the mailbox to your MAPI profile and use the InfoStores collection to open the folder:

' Get the infostores collection
Set objInfoStores = objSession.InfoStores

' Loop through the infostores
For Each objInfoStore In objInfoStores
  If Left (objInfoStore.Name, 7) = "Mailbox" Then

    ' Open the root folder
    Set objRootFolder = objInfoStore.RootFolder

    ' Open the Calendar folder
    Set objFolder = objRootFolder.Folders("Calendar")
  End If
Next

Note that this method does not provide a way to retrieve a valid AppointmentItems collection because you can only use the GetDefaultFolder method to retrieve a valid AppointmentItems collection.

2. Logon with a new session to the mailbox and open the folder:

' Get the Global Address List
Set objAddressList = objSession.GetAddressList(CdoAddressListGAL)

' Get the first GAL entry, assuming it is a mailbox
Set objAddressEntry = objAddressList.Items(1)

' Get the home server name out of the home MTA property
strHomeServer = objAddressEntry.Fields(CdoPR_EMS_AB_HOME_MTA)
strHomeServer = Mid(strHomeServer, InStr(1, strHomeServer,_
"/cn=Configuration/cn=Servers/cn=") +_
Len("/cn=Configuration/cn=Servers/cn="),255)
strHomeServer = Left(strHomeServer, InStr(1, strHomeServer, "/") -1)

' Create a dynamic profile and logon
strProfileInfo = strNewHomeServer & Chr(10) & _
   objAddressEntry.Fields.Item(CdoPR_ACCOUNT).Value
Set objNewSession = CreateObject("MAPI.Session")
objNewSession.Logon NewSession:=True, ShowDialog:=False, ProfileInfo:=strProfileInfo

' Get the calendar folder
Set objFolder = objNewSession.GetDefaultFolder(CdoDefaultFolderCalendar )

Note that this method requires owner permissions on the mailbox itself. It is not enough to add the user with permissions to the particular folder. This is by design in CDO 1.x and there seems to be no workaround.

Also the current implementation of Extended MAPI, used by CDO 1.x, exposes a memory leak that occurs each time a Session.Logon is invoked. This is documented in the Microsoft Knowledge Base and there is no fix available yet.
Make a mailbox folder available offline Microsoft Outlook 9x does not provide a convenience way to make more than one folder once a time available for offline use (note that this has been changed in Microsoft Outlook 2000). Sometimes it is required to do this programmatically. Here is a way, using CDO 1.x, to make a folder available offline by code:
' Folder offline flag MAPI property
Public Const CdoPR_OFFLINE_FLAG = &H663D0003

' Get contact folder
Set objFolder = objSession.GetDefaultFolder(5)

' Get fields collection of the particular folder
Set objFields = objFolder.Fields

' Get offline flag
Set OfflineFlags = objFields.Item(CdoPR_OFFLINE_FLAG)

' Check if field is already present
If OfflineFlags Is Nothing Then

  ' Field is not present yet, add it to the folder properties
  Set OfflineFlags = objFields.Add(CdoPR_OFFLINE_FLAG, 1)
End If

' Enable offline flag
OfflineFlags.Value = 1

' Update folder properties
objFolder.Update
Access Outlook contact data CDO 1.x does not have a build-in feature to access Microsoft Outlook contact data. However, Microsoft includes the ability to use contacts via Microsoft Outlook Web Access with Microsoft Exchange Server 5.5 Service Pack 1 (or higher). Here is a sample how to read an Outlook contact record:
' Get the default contacts folder
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderContacts)

' Get contact items collection
Set objMessages = objFolder.Messages

' Get first contact
Set objMessage = objMessages.GetFirst()

' Get the fields collection of the Microsoft Outlook contact item
Set objFields = objMessage.Fields

' Get some fields
Set objLastName = objFields(CdoPR_SURNAME)
Set objBusinessPhone = objFields(CdoPR_BUSINESS_TELEPHONE_NUMBER)
Set objEMailAddress = objFields(CdoContact_EmailAddress)
Set objWebPage = objFields(CdoContact_WebPage)

' Pull out the information
MsgBox "LastName: " & objLastName.Value
MsgBox "BusinessPhone: " & objBusinessPhone.Value
MsgBox "EMailAddress: " & objEMailAddress.Value
MsgBox "WebPage: " & objWebPage.Value
Create an Outlook Contact with CDO While it is not documented it is possible to create Outlook contacts with CDO 1.x. Actually creating the contact itself isn't that hard but populating the appropriate fields can become a nightmare. The following code creates a contact with a business address and also sets categories:
' MAPI property tags used
Public Const CdoPR_DISPLAY_NAME = &H3001001F
Public Const CdoPR_COMPANY_NAME = &H3A16001F
Public Const CdoPR_SURNAME = &H3A11001E
Public Const CdoPR_MIDDLE_NAME = &H3A44001F
Public Const CdoPR_GIVEN_NAME = &H3A06001F
Public Const CdoPR_GENERATION = &H3A05001E
Public Const CdoPR_INITIALS = &H3A0A001E
Public Const CdoPR_DISPLAY_NAME_PREFIX = &H3A45001E
Public Const CdoPR_STREET_ADDRESS = &H3A29001E
Public Const CdoPR_LOCALITY = &H3A27001E
Public Const CdoPR_STATE_OR_PROVINCE = &H3A28001E
Public Const CdoPR_POSTAL_CODE = &H3A2A001E
Public Const CdoPR_BUSINESS_ADDRESS_COUNTRY = &H3A26001E
Public Const CdoPR_POSTAL_ADDRESS = &H3A15001E

Public Const CdoPropSetID3 = "0420060000000000C000000000000046"
Public Const CdoPropSetID5 = "2903020000000000C000000000000046"

Public Const CdoContact_FileUnder = "0x8005"
Public Const CdoContact_FileUnderID = "0x8006"
Public Const CdoContact_EmailOriginalDisplayName = "0x8084"
Public Const CdoContact_EmailEmailAddress = "0x8083"
Public Const CdoContact_EmailAddrType = "0x8082"
Public Const CdoContact_EmailOriginalEntryID = "0x8085"
Public Const CdoContact_SelectedAddress = "0x8022"
Public Const CdoContact_BusinessAddress = "0x801B"
Public Const CdoContact_BusinessAddressCity = "0x8046"
Public Const CdoContact_BusinessAddressStreet = "0x8045"
Public Const CdoContact_BusinessAddressState = "0x8047"
Public Const CdoContact_BusinessAddressCountry = "0x8049"
Public Const CdoContact_BusinessAddressPostalCode = "0x8048"
Public Const CdoContact_BusinessAddressPostOfficeBox = "0x804A"
Public Const CdoContact_Categories = "Keywords"

' Contact data
strBusinessAddressStreet = "SomeStreet"
strBusinessAddressCountry = "Germany"  ' Must be a valid country name
strBusinessAddressCity = "SomeCity"
strBusinessAddressPostalCode = "SomeZIP"
strBusinessAddressState = "SomeState"
strBusinessAddress = strBusinessAddressStreet & Chr(13) & strBusinessAddressPostalCode & " " & strBusinessAddressCity & ", " & strBusinessAddressState & Chr(13) & strBusinessAddressCountry
strFirstName = "John"
strLastName = "Doe"
strInitial = "B."
strCompanyName = "SomeCompany"
strPrefix = "Mr."
strSuffix = "Sr."
strEmailAddress = "john@doe.com"
strEmailAddressType = "SMTP"
strCategories(0) = "Business"
strCategories(1) = "Competition"
strCategories(2) = "Favorites"
strCategories(3) = "Gifts"

' Get the default contact folder
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderContacts )

' Create a new message
Set objMessage = objFolder.Messages.Add

' Set message class and subject
objMessage.Type = "IPM.Contact"
objMessage.Subject = strFirstName & " " & strLastName

' Create conversation index
objMessage.ConversationIndex = objSession.CreateConversationIndex

' Get fields collection
Set objFields = objMessage.Fields

' Add fields to message
With objFields

  ' Create/write standard fields (e. g. the display name)
  .Add CdoPR_DISPLAY_NAME, objMessage.Subject
  .Add CdoPR_DISPLAY_NAME_PREFIX, strPrefix
  .Add CdoPR_COMPANY_NAME, strCompanyName
  .Add CdoPR_SURNAME, strLastName
  .Add CdoPR_MIDDLE_NAME, strInitial
  .Add CdoPR_GIVEN_NAME, strFirstName
  .Add CdoPR_INITIALS, Left(strFirstName, 1) & " " & strInitial & " " _
    & Left(strLastName, 1)
  .Add CdoPR_GENERATION, strSuffix

  ' Write Outlook "FileAs"
  .Add CdoContact_FileUnder, vbString, _
    objMessage.Subject, CdoPropSetID3
  .Add CdoContact_FileUnderID, vbLong, _
    &HFFFFFFFF, CdoPropSetID3

  ' Write Outlook "Business Address" fields
  .Add CdoContact_BusinessAddressStreet, vbString, _
    strBusinessAddressStreet, CdoPropSetID3
  .Add CdoContact_BusinessAddressCity, vbString, _
    strBusinessAddressCity, CdoPropSetID3
  .Add CdoContact_BusinessAddressState, vbString,_
     strBusinessAddressState, CdoPropSetID3
  .Add CdoContact_BusinessAddressPostalCode, vbString,_
     strBusinessAddressPostalCode, CdoPropSetID3
  .Add CdoContact_BusinessAddressCountry, vbString,_
     strBusinessAddressCountry, CdoPropSetID3
  .Add CdoContact_BusinessAddress, vbString,_
     strBusinessAddress, CdoPropSetID3

  ' Write Outlook "Mailing Address" fields with the same values as the selected address
  .Add CdoPR_STREET_ADDRESS, strBusinessAddressStreet
  .Add CdoPR_LOCALITY, strBusinessAddressCity
  .Add CdoPR_STATE_OR_PROVINCE, strBusinessAddressState
  .Add CdoPR_POSTAL_CODE, strBusinessAddressPostalCode
  .Add CdoPR_BUSINESS_ADDRESS_COUNTRY, strBusinessAddressCountry
  .Add CdoPR_POSTAL_ADDRESS, strBusinessAddress

  ' Write Outlook "Selected Address" field
  .Add CdoContact_SelectedAddress, vbLong, 2, CdoPropSetID3

  ' Write first Outlook "E-mail address"
  .Add CdoContact_EmailOriginalDisplayName, vbString, strEmailAddress, CdoPropSetID3
  .Add CdoContact_EmailEmailAddress, vbString, strEmailAddress, CdoPropSetID3
  .Add CdoContact_EmailAddrType, vbString, strEmailAddressType, CdoPropSetID3

  ' Add categories
  .Add CdoContact_Categories, vbString Or vbArray, strCategories, CdoPropSetID5

  ' Add a custom field
  .Add "Position", vbString, "CEO", CdoPropSetID5
End With

' Save message
objMessage.Update True, True
Filter on Outlook task complete field CDO 1.x does not have a build-in feature to access Microsoft Outlook task data. But it is possible to access them with undocumented MAPI properties. Filtering seems to be impossible because of the fact that GUID-based MAPI properties are used to access the Outlook task data. However, there is a workaround for this problem and here is a sample how to filter an Outlook tasks folder:
' MAPI property tag for Task Complete field
Const CdoTask_Complete = "{0320060000000000C000000000000046}0x8111"

' Get the default task folder
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderTasks)

' Get task message collection
Set objMessages = objFolder.Messages

' Get a task message
Set objTaskMessage = objFolder.Messages.GetFirst()

' Because CDO 1.x does not support to use GUID-based MAPI properties
' in a message filter you must convert the GUID-based into a standard MAPI property
Set objFields = objTaskMessage.Fields
Set objCompleteField = objFields.Item(CdoTask_Complete)
strCompleteField =  objCompleteField.ID

' Create filter
Set objMessageFilter = objMessages.Filter

'  Set filter on Task Complete field
objMessageFilter.Fields.Add strCompleteField, True
Change the published Free/Busy month Per default CDO publishes only three month of free busy information to the Microsoft Exchange Server. Here is a code snippet how to read and change the value:
' Read the value of published Free/Busy months
intMonths = objSession.GetOption("FreeBusyMonths")

' Set published Free/Busy months to 12 months
objSession.SetOption "FreeBusyMonths", 12

This feature is introduced with an updated CDO library which is included in Microsoft Exchange 5.5 Service Pack 2 (or higher). You can also download the CDO library from Microsoft separately. For more information please take a look at Links @ Microsoft. Note that the CDO version remains unchanged.
Access categories of a message You can access the categories of a message using CDO. Here is an easy way to do that:
' Get the message collection of the inbox
Set objMessages = objSession.Inbox.Messages

' Get first message
Set objMessage = objMessages.GetFirst

' Get categories of message
strCategories = objMessage.Categories

' Pull out each category
For intCounter = LBound(strCategories) To UBound(strCategories)
      MsgBox = "Category: " & strCategories(intCounter)
Next
Change Outlook Folder AutoArchive settings Outlook provides an option to set AutoArchive options on a per folder basis. This information is stored in a hidden message in the particular folder with a message class of "IPC.MS.Outlook.AgingProperties". Since CDO 1.2x provides access to hidden messages you can use the following code to change the aging properties:
' MAPI property tags for aging properties
Public Const CdoPR_AGING_PERIOD = &H36EC0003
Public Const CdoPR_AGING_GRANULARITY = &H36EE0003
Public Const CdoPR_AGING_PATH = &H6856001E
Public Const CdoPR_AGING_ENABLED = &H6857000B

' Properties for aging granularity
Public Const AG_MONTHS = 0
Public Const AG_WEEKS = 1
Public Const AG_DAYS = 2 

' Get the inbox folder
Set objInboxFolder = objSession.Inbox

' Get hidden message collection
Set objHiddenMessages = objInboxFolder.HiddenMessages

' Loop through the hidden messages collection
For Each objMessage In objHiddenMessages

  ' Check if the message class points to an aging message
  If objMessage.Type = "IPC.MS.Outlook.AgingProperties" Then

    ' Change aging properties to 14 months/weeks/days
    objMessage.Fields.Item(CdoPR_AGING_PERIOD).Value = 14

    ' Change aging granularity to days
    objMessage.Fields.Item(CdoPR_AGING_GRANULARITY).Value = AG_DAYS

    ' Change the path to the archive file
    objMessage.Fields.Item(CdoPR_AGING_PATH).Value = "C:\Temp\archive.pst"

    ' Enable aging for this folder
    objMessage.Fields.Item(CdoPR_AGING_ENABLED).Value = True

    ' Update hidden message
    objMessage.Update True, True
  End If
Next

Note that Outlook sometimes caches information and it is possible that the changes are only displayed after closing and re-opening Outlook. Also this hidden message does only exist if the AutoArchive option was at least turned on once with Outlook itself.
Flag a message for Follow up While it is possible with the Outlook user interface to flag a message for a particular action neither the Outlook object model nor CDO 1.x provides a direct way to accomplish that programmatically. However, it is possible to use CDO 1.x and undocumented MAPI properties to flag a message or a contact for a particular action. You can use the following code to set the message flag:
' Outlook property set ID
Const CdoPropSetID4 = "0820060000000000C000000000000046"

' MAPI property tag used
Const CdoPR_REPLY_REQUESTED = &H0C17000B
Const CdoPR_RESPONSE_REQUESTED = &H0063000B
Const CdoPR_REPLY_TIME = &H00300040
Const CdoPR_FLAG_STATUS = &H10900003
Const CdoPR_FLAG_TEXT = "0x8530"
Const CdoPR_FLAG_DUE_BY = "0x8502"
Const CdoPR_FLAG_DUE_BY_NEXT = "0x8560"
Const CdoPR_FLAG_COMPLETE = &H10910040

' Flag status
Const FLAG_NONE = 0
Const FLAG_WHITE = 1
Const FLAG_RED = 2

' Get inbox
Set objFolder = objSession.Inbox

' Get first message
Set objMessage = objFolder.Messages.GetFirst()

' Get message fields
Set objFields = objMessage.Fields

' Set red flag
objFields.Add CdoPR_FLAG_STATUS, FLAG_RED

' Set flag for follow up
objFields.Add CdoPR_REPLY_REQUESTED, True
objFields.Add CdoPR_RESPONSE_REQUESTED, True
objFields.Add CdoPR_FLAG_TEXT, 8, "Follow up", CdoPropSetID4

' Set due date to tomorrow
objFields.Add CdoPR_FLAG_DUE_BY, 7, Now + 1, CdoPropSetID4
objFields.Add CdoPR_FLAG_DUE_BY_NEXT, 7, Now + 1, CdoPropSetID4
objFields.Add CdoPR_REPLY_TIME, Now + 1

' Update message
objMessage.Update
Get the Internet Header of a Message When a SMTP message is received with a MAPI mail client the message is converted and all SMTP properties are mapped into MAPI properties. The SMTP header is stored in a single MAPI property and can be accessed using the following code:
' MAPI property tag used
Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H007D001E

' Get inbox
Set objFolder = objSession.Inbox

' Get first message
Set objMessage = objFolder.Messages.GetFirst()

' Get message fields
Set objFields = objMessage.Fields

' Get SMTP header
strHeader = objFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value
Set the Outlook Reply/Forward Flag When you reply to a message with Outlook the original message gets a beige line at the top with the information when you replied/forwarded to the message. Also the message icon will change. Unfortunately this doesn't work when you reply to a message with CDO 1.x. However, the following code set the reply/forward flag so that Outlook recognizes that you have replied/forwarded to the message programmatically:
' MAPI property tags used
Const CdoPR_ACTION = &H10800003
Const CdoPR_ACTION_FLAG = &H10810003
Const CdoPR_ACTION_DATE = &H10820040

' Constants for Reply/Foward actions
Const ACTION_REPLY = 261
Const ACTION_FORWARD = 262
Const ACTION_REPLY_SENDER = 102
Const ACTION_REPLY_ALL = 103
Const ACTION_FORWARD_FORWARD = 104

' Get inbox
Set objFolder = objSession.Inbox

' Get first message
Set objMessage = objFolder.Messages.GetFirst()

' Get fields collection
Set objFields = objMessage.Fields

' Set Reply flag to "Reply To Sender"
objFields.Add CdoPR_ACTION_DATE, Now
objFields.Add CdoPR_ACTION, ACTION_REPLY
objFields.Add CdoPR_ACTION_FLAG, ACTION_REPLY_SENDER

' Or set Reply flag to "Reply To All"
objFields.Add CdoPR_ACTION_DATE, Now
objFields.Add CdoPR_ACTION, ACTION_REPLY
objFields.Add CdoPR_ACTION_FLAG, ACTION_REPLY_ALL

' Or set forward flag to "Forwarded"
objFields.Add CdoPR_ACTION_DATE, Now
objFields.Add CdoPR_ACTION,  ACTION_FORWARD
objFields.Add CdoPR_ACTION_FLAG, ACTION_FORWARD_FORWARD

' Update message
objMessage.Update
Get the SMTP address of the current user You can read the SMTP address of a mailbox or custom recipient. But if you try to use objAddressEntry.Address you will receive the Exchange address (also known as 'Distinguish Name') and not the SMTP address. Here is how to read the SMTP address:
' MAPI property tag for SMTP address
Public Const CdoPR_EMAIL = &H39FE001E

' Get current user object
Set objAddressEntry = objSession.CurrentUser

' Get the address entry ID
strAddressEntryID = objAddressEntry.ID

' Get the SMTP address
strEMailAddress =_
objSession.GetAddressEntry(strAddressEntryID).Fields(CdoPR_EMAIL)

' Display the SMTP address of current user
MsgBox "SMTP address of current user: " & strEMailAddress

Note that you must use exactly the way described above. Otherwise you will fail to get the SMTP address.
Get the e-mail addresses of the current user The e-mail addresses (also known as 'Proxy Addresses') are stored in a multivalued MAPI property. Here is how to read this multivalued property:
' MAPI property tag for e-mail addresses
Public Const PR_EMS_AB_PROXY_ADDRESSES = &H800F101E

' Array for e-mail addresses
Dim strAddresses

' Get current user object
Set objAddressEntry = objSession.CurrentUser

' Get the fields collection of the address entry
Set objFields = objAddressEntry.Fields

' Pull out proxy addresses
Set objMailAddresses = objFields.Item(PR_EMS_AB_PROXY_ADDRESSES)
If Not objMailAddresses Is Nothing Then

  ' Add the addresses to an array
  strAddresses = objMailAddresses.Value

  ' Loop through the array and display single address
  For intCounter = LBound(strAddresses) To UBound(strAddresses)
    MsgBox intCounter & ". E-mail address: " & strAddresses(intCounter)
  Next
End If
Get the SMTP address of the originator of a message  You can read the SMTP address of the originator of a message. But if you try to use objAddressEntry.Address you will receive the Exchange address (also known as 'Distinguish Name' if the originator is an Exchange mailbox) and not the SMTP address. Here is how to read the SMTP address:
' MAPI property tag for SMTP address
Public Const CdoPR_EMAIL = &H39FE001E

' Get first message from inbox
Set objFolder = objSession.Inbox
Set objMessages = objFolder.Messages
Set objMessage = objMessages.GetFirst()

' Get address
Set objAddressEntry = objMessage.Sender
strEMailAddress = objAddressEntry.Address

' Check if it is an Exchange object
If Left(strEMailAddress, 3) = "/o=" Then

  ' Get the SMTP address
  strAddressEntryID = objAddressEntry.ID
  strEMailAddress =_
    objSession.GetAddressEntry(strAddressEntryID).Fields(CdoPR_EMAIL).Value
End If

' Display the SMTP address of current user
MsgBox "SMTP address of current user: " & strEMailAddress

Note that you must use exactly the way described above. Otherwise you will fail to get the SMTP address.
Get the unread count of a folder You can read the unread message count of a folder without iterating through all items. But instead of counting all unread items of a folder using the approach described below is very fast. Here is how to get the folder unread count:
' MAPI property tags used
Const CdoPR_IPM_PUBLIC_FOLDERS_ENTRYID = &H66310102
Const CdoPR_CONTENT_UNREAD = &H36030003

Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, False, 0

' Get information stores
Set objInfoStores = objSession.InfoStores

' Find public store
For Each objInfoStore In objInfoStores
  Err.Clear
    strRootID = _
      objInfoStore.Fields(CdoPR_IPM_PUBLIC_FOLDERS_ENTRYID).Value
    If Err.Number = 0 Then
      Set objTopFolder = objSession.GetFolder(strRootID, objInfoStore.ID)
      Exit For
  End If
Next

' Get your folder
Set objFolder = _
  objTopFolder.Folders("FirstFolder").Folders("SecondFolder").Folders("MyFolder")

' Get unread count
If Not objFolder Is Nothing
  Set objFields = objFolder.Fields
  Set objField = objFields.Item(CdoPR_CONTENT_UNREAD)
  MsgBox objField.Value
End If

' Close session
objSession.Logoff
Find the home server of the current user You can find the home server of a mailbox, but you need to get a specific MAPI property and filter the server name out of the returned string. Here is how to get the home server:
' MAPI property tag for home MTA
Public Const PR_EMS_AB_HOME_MTA = &H8007001E

' Get current user address entry ID
strUserID = objSession.CurrentUser.ID

' Get the home server name out of the home MTA property
strHomeServer =_
objSession.GetAddressEntry(strUserID).Fields(PR_EMS_AB_HOME_MTA)
strHomeServer = Mid(strHomeServer, InStr(1, strHomeServer,_
"/cn=Configuration/cn=Servers/cn=") +_
Len("/cn=Configuration/cn=Servers/cn="),255)
strHomeServer = Left(strHomeServer, InStr(1, strHomeServer, "/") -1)
Send a message with deferred sending or deferred delivery date & time You can send a message at a specific date & time using the deferred sending and deferred delivery options:
' MAPI property for deferred sending
Public Const PR_DEFERRED_SEND_TIME = &H3FEF0040

' MAPI property for deferred delivery
Public Const CdoPR_DEFERRED_DELIVERY_TIME = &H000F0040

' Create a new message
Set objNewMessage = objSession.Outbox.Messages.Add

' Add subject
objNewMessage.Subject = "This is a message created with CDO"

' Setting deferred sending means the message will stay in the outbox
objNewMessage.Fields.Add(PR_DEFERRED_SEND_TIME) =_
CDate("11/16/98 12:00:00 AM")

' Setting deferred delivery means the message waits in the MTA queue
objNewMessage.Fields.Add(CdoPR_DEFERRED_DELIVERY_TIME) =_
CDate("11/16/98 12:00:00 AM")

' Add recipient and resolve against directory
Set objRecipient = objNewMessage.Recipients.Add
objRecipient.Name = "John Doe"
objRecipient.Resolve

' Send message
objNewMessage.Update
objNewMessage.Send
Change the From address of a message If you are using anonymous access to post items to a public folder you can change the from address of an item using the following code. Note that this will NOTwork if you want to set the sender of an e-mail message. This has to be done using a different approach and is described below this tip.
' MAPI properties needed to set the from address
Public Const CdoPR_SENT_REPRESENTING_ADDRTYPE =_
&H0064001E
Public Const CdoPR_SENT_REPRESENTING_EMAIL_ADDRESS =_
&H0065001E
Public Const CdoPR_SENT_REPRESENTING_NAME =_
&H0042001E

' Set the source folder
Set objFolder = objSession.Inbox

' Get message collection of the inbox
Set objMessages = objSession.Inbox.Messages

' Get first message of inbox
Set objMessage = objMessages.GetFirst()

' Setting the from address
objMessage.Fields.Add(CdoPR_SENT_REPRESENTING_NAME) ,_
"John Doe"
objMessage.Fields.Add(CdoPR_SENT_REPRESENTING_EMAIL_ADDRESS)_
, "JohnD@YourDomain.Com"
objMessage.Fields.Add(CdoPR_SENT_REPRESENTING_ADDRTYPE) ,_
"SMTP"

' Update message
objMessage.Update
Create a new message with a different originator By default the originator if each post in a public folder or newly composed message  is the identity of current logged on mailbox. However, if you want to write e .g. a synchronization between a database and a public contact folder, or send mails with a different originator, and you want to let it show up with a different name you need to provide a valid Exchange AddressEntry object as originator:
' Get the current folder
Set objFolder = objSession.GetFolder(strFolderID, Null)

' Get global address list
Set objAddressList = objSession.AddressLists("Global Address List")

' Get first entry of the global address list
Set objAddressEntry = objAddressList.AddressEntries(1)

' Add a new message
Set objMessage = objFolder.Messages.Add

' Set the message class and subject
objMessage.Type = "IPM.Post"
objMessage.Subject = "New post to this folder"

' Set message originator
objMessage.Sender = objAddressEntry

' Update and post message
objMessage.TimeReceived = Now
objMessage.TimeSent = Now
objMessage.Sent = True
objMessage.Submitted = False
objMessage.Unread = True
objMessage.Update

Note that you must have appropriate permissions on the particular address entry to use it as a message originator. As minimum Send As is required in Microsoft Exchange server.
Execute an application from within a scripting agent script By default you can not execute applications or batch files from within an agent script. However, here is a workaround using Microsoft Windows Scripting Host to accomplish that:
Set objWSHShell = CreateObject("WScript.Shell")
objWSHShell.Run("notepad.exe")

Note that you need Windows Scripting Host (WSH) installed on the machine. WSH is installed with IIS4.0/Windows NT 4.0 Option Pack or you can download and install it separately of the Microsoft Web site.
Use another application from within a scripting agent script In your own Scripting Agent solution you can use each application, which supports the COM interface. Here is a sample how to use Microsoft Internet Explorer 4.x:
Set objBrowser = CreateObject("InternetExplorer.Application")
objBrowser.Visible = True
objBrowser.Navigate "http://www.cdolive.com"
Read the master categories list of a user You can use Microsoft Windows Scripting Host to read the Microsoft Outlook  master categories list stored inside the registry:
' For Microsoft Outlook 98 use the following code
Set objWSHShell = CreateObject("WScript.Shell")
strCategories = objWSHShell.RegRead_
("HKEY_CURRENT_USER\Software\Microsoft\Office\8.0\Outlook\Categories\")

' For Microsoft Outlook 2000 use the following code
Set objWSHShell = CreateObject("WScript.Shell")
strCategories = objWSHShell.RegRead_
("HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Outlook\Categories\MasterList")

' For Microsoft Outlook 2002 it is now stored at:
HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Categories\MasterList,

but it is no longer a string value. Instead it is now in binary format and you need to use code like this to read it:

For intCounter = 1 To Len(strCategories)
  lngChar = CLng("&H" & Mid(strCategories, intCounter * 2 - 1, 2))
  If lngChar <> 0 Then
    strMasterList = strMasterList & Chr(lngChar)
  End If
Next

Note that the master categories list does only exist if the user already used it, e. g. s/he added his/her own category (in Outlook 9x) or opened the category dialog (in Outlook 2000).

Note that you need Windows Scripting Host (WSH) installed on the machine. WSH is installed with IIS4.0/Windows NT 4.0 Option Pack or you can download and install it separately of the Microsoft Web site.
Send a message with an Exchange Server Scripting Agent script using Outlook voting buttons Unfortunately CDO 1.x cannot be used directly to send message with Outlook voting buttons. However, if you are running Exchange Server 5.5 with Service Pack 1 (or higher) installed you can use one of the helper functions provided by Microsoft  with the Routing Engine to accomplish that. Use the following code to set the voting buttons on the message:
' Get the session
Set objSession = EventDetails.Session

' Create a new message
Set objFolderOutbox = objSession.Outbox
Set objMessage = objFolderOutbox.Messages.Add

' Add recipients
Set objRecipient = objMessage.Recipients.Add
objRecipient.Name = "<Add your Recipient here>"

' Resolve recipient against the Exchange Directory
objRecipient.Resolve

' Create "Yes" and "No" voting buttons
Set objVoteButton = CreateObject("ExRt.VoteButton.1")
If Err.Number = 0 Then
  varRet = objVoteButton.PopulateVoteMessage(objMessage, "Yes,No")
End If

' Send message
objMessage.Update
objMessage.Send
Note that you must have Exchange Server 5.5 Service Pack 1 (or higher) installed and working properly.
Send a message with an Exchange Server Scripting Agent script using a specific message class If you want to use an Exchange Scripting Agent script to sent a message which should be displayed in a particular Outlook Form, you must set the Message Class as following:
' Get the session
Set objSession = EventDetails.Session

' Get the current folder
Set objFolder = objSession.GetFolder(EventDetails.FolderID,Null)

' Create a new message and set the recipient
Set objFolderOutbox = objSession.Outbox
Set objNotifyMsg = objFolderOutbox.Messages.Add
Set objRecipient = objNotifyMsg.Recipients.Add
objRecipient.Name = "<Add your Recipient here>"

' Resolve recipient against the Exchange Directory
objRecipient.Resolve

' Set message class to the message class used in the Outlook Form
objNotifyMsg.Type = "IPM.Note.YourMessageClass"

' Send message
objNotifyMsg.Update
objNotifyMsg.Send
Reference a User Defined Field (UDF) inside an Exchange Server Scripting Agent script If you want to reference a User Defined Field in a folder, use the following code:
' Get the session
Set objSession = EventDetails.Session

' Get the current folder
Set objFolder = objSession.GetFolder(EventDetails.FolderID,Null)

' Get the current message
Set objCurrentMsg = objSession.GetMessage(EventDetails.MessageID,Null)

' Read an User Defined Field
On Error Resume Next
strField = objCurrentMsg.Fields("<Add Your Field Name here>")

Note that a user defined field is per default only created for a message. If you create a new form and you define a custom field, it will be only visible in the message if it contains a value. If you create a new message with your form in the folder and the custom field does not contain a value you will get an error if you try to access it with your agent script.

To work around that you can either define the custom field on folder level first before you access it with an agent script or put an 'On Error Resume Next' statement in your agent script before each access to a custom field (see the code snippet above).

Note that there is an article 'Working With User-defined Fields in Solutions' at the Microsoft Knowledge Base about that behavior. For more information, please take a look at Knowledge Base Articles about CDO & Scripting and Routing
Create a response to the message originator with an Exchange Server Scripting Agent script If you want to create an auto reply to the sender of a message posted in a particular folder, use the following code:
' Get the session
Set objSession = EventDetails.Session

' Get the current folder
Set objFolder = objSession.GetFolder(EventDetails.FolderID,Null)

' Get the current message
Set objCurrentMsg = objSession.GetMessage(EventDetails.MessageID,Null)

' Create a new message and set recipient
Set objFolderOutbox = objSession.Outbox
Set objNotifyMsg = objFolderOutbox.Messages.Add

' Set sender as the new recipient
objNotifyMsg.Recipients.Add "", "", 1, objCurrentMsg.Sender.ID

' Set message text
objNotifyMsg.Text = "This is an automated reply"

' Send message
objNotifyMsg.Update
objNotifyMsg.Send
Delete a member of a distribution list located at the global address If you need to delete a particular member from a distribution list located at the global address list with an Outlook form you can use this code snippet:
' Get current user
Set objUser = objSession.CurrentUser

' Create new message and set DL
Set objNewMessage = objSession.Outbox.Messages.Add
Set objNewRecip = objNewMessage.Recipients.Add
objNewRecip.Name = "<Insert the name of the DL here>"

' Resolve address against the Exchange Directory
objNewRecip.Resolve

' Set Distribution List and get members
Set objDistributionList = objNewRecip.AddressEntry
Set objMembers = objDistributionList.Members
intCounter = 1

' Loop through the members and find yourself
For Each objMember In objMembers
  If Trim(UCase(objMember.Address)) = Trim(UCase(objUser.Address)) Then

    ' To prevent an error message skip it with the following statement
    On Error Resume Next

    ' Delete yourself
    objMember.Delete
  End If
Next

' Update and delete message
objNewMessage.Update
objNewMessage.Delete

Note that CDO.HLP file stated that you cannot add or delete members from a distribution list located at the global address list. However, you can delete a member but you cannot add a member to a distribution list located at the global address list.
Trap all deleted items of a particular public folder with an Exchange Server Scripting Agent script You can create an Exchange Server Scripting Agent script, which fires each time an item is deleted in a particular folder. However, you cannot get any information of the deleted item, because the script is fired asynchronously and the item is already gone if your script starts execution. This is a known issue and there is currently no workaround for items in public folder.
A limited workaround for private folders is to create a Microsoft Exchange Server Scripting and Routing script at the 'Deleted Items' folder of a mailbox, which fires each time a new item is added because the user has deleted an item from another folder of his/her mailbox. This solution works only if the user does not hit SHIFT+DEL to delete the item without moving it to the 'Deleted Items' folder.

Before you start to build a Microsoft Exchange Server Scripting and Routing script, please take the time and review 'The Secrets of Exchange Server Scripting and Routing', Introduction about the limitations.

' Get the session
Set objSession = EventDetails.Session

' Get the current folder
Set objFolder = objSession.GetFolder(EventDetails.FolderID,Null)

' Get the current message will fail because you get an ID for an already deleted message
Set objCurrentMsg = objSession.GetMessage(EventDetails.MessageID,Null)

' Create a new message and set recipient
Set objFolderOutbox = objSession.Outbox
Set objNotifyMsg = objFolderOutbox.Messages.Add

' Set sender as the new recipient
objNotifyMsg.Recipients.Add "", "", 1, objCurrentMsg.Sender.ID

' Write message ID into the response text
objNotifyMsg.Text = "Message ID: " & objCurrentMsg.ID

' Send message
objNotifyMsg.Update
objNotifyMsg.Send