VBOffice

Kontakte zur Nachverfolgung kennzeichnen

Mit VBA können Sie sogar Kontakte zur Nachverfolgung kennzeichnen und so mit einer Erinnerung versehen.

Zuletzt geändert: 19.01.2006 | Aufrufe: 41.387  | #8
◀ Vorheriges Beispiel Nächstes Beispiel ▶
OLKeeper OLKeeper
Der OLKeeper verhindert zuverlässig, dass Sie Microsoft Outlook unbeabsichtigt schließen und so etwa wichtige Emails verpassen würden.

Das Objektmodell von Outlook 2003 bietet keine Möglichkeit, Kontakte zu kennzeichnen. Mit der CDO 1.21 Bibliothek geht es aber.


tip  So fügen Sie Makros in Outlook ein
Private 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
    ' Flag löschen
    DeleteField oFields, CdoPR_FLAG_STATUS
    DeleteField oFields, CdoPR_FLAG_DUE_BY
    DeleteField oFields, CdoPR_FLAG_TEXT

  Case 1
    ' Weißes Flag (erledigt)
    AddField oFields, CdoPR_FLAG_STATUS, vbLong, lFlagStatus

  Case 2
    ' Rotes 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
Mit diesem Addin für Outlook erhalten Sie in verschiedenen Situationen eine Warnung, bevor Sie auf eine Email versehentlich allen anderen Empfängern antworten.

So rufen Sie die Funktion z.B. für einen im Ordner ausgewählten Kontakt auf, setzen den Text auf 'Anrufen' und die Fälligkeit auf nächste Woche:

Public Sub FlagContact()
  Dim Contact As Outlook.ContactItem
  Dim Due As Date, Msg As String
  
  'Fällig in sieben Tagen
  Due = DateAdd("d", 7, Date)
  Msg = "Anrufen"

  Set Contact = Application.ActiveExplorer.Selection(1)
  FlagContact_Ex Contact, 2, Due, Msg
End Sub
SAM SAM
Legen Sie fest, mit welcher "Identität" Ihre Emails beim Empfänger erscheinen sollen. Mit SAM bestimmen Sie den Absender und Speicherort für Emails anhand von Regeln.
email  Senden Sie eine Nachricht