VBOffice

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.567  | #8
◀ Previous sample Next sample ▶
Category-Manager Category-Manager
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP.

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
    oField.Delete
  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
SAM SAM
Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.
email  Send a message