VBOffice

Edit the Internet Format for a Contact

This macro allows you to determine the format (plain, html, rtf) to be used for sending emails for each of the three email addresses of a contact.

Last modified: 2006/09/11 | Accessed: 30.534  | #32
◀ Previous sample Next sample ▶
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.

A contact in Outlook might have up to three e-mail addresses, and for every one you can determine the format that Outlook should use for sending e-mails.

Since Outlook 2000 there're the settings: a) Let Outlook decide the best sending format, b) Send using Outlook Rich Text format.

Since Outlook XP there's a third option: c) Send Plain Text only.

The information, which format to use, is written in the EntryID of each address. Using the Outlook object model, that property is read-only. If you want to change it you must use CDO 1.21 or the Redemption.

This sample shows how to change the sending format for the first e-mail address (EMail1EntryID) by using the Redemption. If you want to change the format also for the second and third address, there're yet the necessary IDs (EMail2EntryID and EMail3EntryID), so that you're able to extend the sample yourself.


tip  How to add macros to Outlook
Private Const SEND_AUTO_FORMAT = 1
Private Const SEND_RTF_FORMAT = 0
Private Const SEND_PLAINTEXT_FORMAT = 7

Public Sub ChangeSendingFormat()
  On Error GoTo cleanUp
  Dim Session As Redemption.RDOSession
  Dim Utils As Redemption.MAPIUtils
  Dim obj As Redemption.rdoMail
  Dim Items As Redemption.RDOItems
  Dim AdrID As Variant
  Dim PropID As Long
  Const GUID As String = "{00062004-0000-0000-C000-000000000046}"
  ' Email1EntryID
  Const ID = &H8085
  ' Email2EntryID = &H8095
  ' Email3EntryID = &H80A5

  Set Session = CreateObject("Redemption.RDOSession")
  Session.LogOn

  Set Items = Session.GetDefaultFolder(olFolderContacts).Items
  If Items.Count Then
    Set Utils = CreateObject("Redemption.MapiUtils")
    Set obj = Items(1)
    PropID = Utils.GetIDsFromNames(obj, GUID, ID)
    PropID = PropID Or &H102

    For Each obj In Items
      If TypeOf obj Is Redemption.RDOContactItem Then
        AdrID = Utils.HrGetOneProp(obj, PropID)
        If Not IsEmpty(AdrID) Then
          AdrID(22) = SEND_AUTO_FORMAT
          Utils.HrSetOneProp obj, PropID, AdrID, True
        End If
      End If
    Next
  End If

cleanUp:
  If Not Session Is Nothing Then
    Session.Logoff
  End If
End Sub
SAM SAM
SAM automatically sets the sending account, or sender address, and folder for sent items based on several criteria.
email  Send a message