|
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.
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