Flag a Contact For Follow-Up

With VBA is's possible to flag even contacts for follow-up and set a reminder.

Last modified: 2006/01/19 | Accessed: 48.675  | #8
◀ Previous sample Next sample ▶
OLKeeper OLKeeper
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.

The object model of Outlook 2003 doesn't support flagging contacts. However, it's possible with the CDO 1.21 library.

tip  How to add macros to Outlook
Public Sub FlagContact_Ex(oContact As Outlook.ContactItem, _
  ByVal lFlagStatus As Long, _
  ByVal dtFlagDueBy As Date, _
  sFlagText As String _
  Dim oMsg As MAPI.Message
  Dim oFields As MAPI.Fields

  Const CdoPropSetID4 As String = "0820060000000000C000000000000046"
  Const CdoPR_FLAG_STATUS As Long = &H10900003
  Const CdoPR_FLAG_DUE_BY As String = "{" & CdoPropSetID4 & "}" & "0x8502"
  Const CdoPR_FLAG_TEXT As String = "{" & CdoPropSetID4 & "}" & "0x8530"

  Set oMsg = GetMessage(oContact)
  Set oFields = oMsg.Fields

  Select Case lFlagStatus
  Case 0
    ' Delete Flag 
    DeleteField oFields, CdoPR_FLAG_STATUS
    DeleteField oFields, CdoPR_FLAG_DUE_BY
    DeleteField oFields, CdoPR_FLAG_TEXT

  Case 1
    ' White Flag (completed)
    AddField oFields, CdoPR_FLAG_STATUS, vbLong, lFlagStatus

  Case 2
    ' Red Flag
    AddField oFields, CdoPR_FLAG_STATUS, vbLong, lFlagStatus
    AddField oFields, CdoPR_FLAG_DUE_BY, vbDate, dtFlagDueBy
    AddField oFields, CdoPR_FLAG_TEXT, vbString, sFlagText
  End Select

  oMsg.Update True
End Sub

Private Sub AddField(oFields As MAPI.Fields, _
  PropTag As Variant, _
  DataType As Variant, _
  Value As Variant _
  On Error Resume Next
  Dim oField As MAPI.Field

  Set oField = oFields(PropTag)
  If oField Is Nothing Then
    Set oField = oFields.Add(PropTag, DataType)
  End If
  oField.Value = Value
End Sub

Private Sub DeleteField(oFields As MAPI.Fields, _
  PropTag As Variant _
  On Error Resume Next
  Dim oField As MAPI.Field

  Set oField = oFields(PropTag)
  If Not oField Is Nothing Then
  End If
End Sub
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.

This calls the macro for the contact item selected in the folder, sets the message to 'Call' and the due date on next week:

Public Sub FlagContact()
  Dim Contact As Outlook.ContactItem
  Dim Due As Date, Msg As String
  'Due in seven days
  Due = DateAdd("d", 7, Date)
  Msg = "Call"

  Set Contact = Application.ActiveExplorer.Selection(1)
  FlagContact_Ex Contact, 2, Due, Msg
End Sub
Reporter Reporter
VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month.
email  Send a message