VBOffice

Kontakte nach Geburtstag sortieren

Mit diesem Script erstellen Sie eine Geburtstagsliste, die korrekterweise nur nach Tag und Monat sortiert und das Geburtsjahr ignoriert.

Zuletzt geändert: 01.02.2013 | Aufrufe: 21.532  | #96
◀ Vorheriges Beispiel Nächstes Beispiel ▶
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.

Kontakte können in Outlook nicht sinnvoll nach dem Geburtstag sortiert werden, weil die Jahreszahl auch mitsortiert wird. Bei Geburtstagen interessieren aber nur der Tag und der Monat.

Diese VBA-Funktion fügt einem auszuwählenden Kontakteordner ein neues Feld hinzu und schreibt Monat und Tag des Geburtstags hinein. Damit richtig sortiert wird, muss der Monat vor dem Tag geschrieben werden, also im Format "mm.dd."


tip  So fügen Sie Makros in Outlook ein
Public Sub AddFormattedBirthday()
  Dim Folder As Outlook.MAPIFolder
  Dim Items As Outlook.Items
  Dim UserProps As Outlook.UserProperties
  Dim Prop As Outlook.UserProperty
  Dim obj As Object
  Dim Contact As Outlook.ContactItem
  Dim BDay As Date
  Dim DateFormat$
  Dim Name$

  'Name des neuen Feldes
  Name = "FormattedBirthday"

  'Datumformat
  DateFormat = "mm.dd."

  While Folder Is Nothing
    Set Folder = Application.Session.PickFolder
    If Folder Is Nothing Then Exit Sub
    If Folder.DefaultItemType <> olContactItem Then
      MsgBox "Es werden nur Kontakteordner unterstützt", vbInformation
      Set Folder = Nothing
    End If
  Wend

  Set Items = Folder.Items
  If Items.Count Then
    For Each obj In Items
      If TypeOf obj Is Outlook.ContactItem Then
        Set Contact = obj
        BDay = Contact.Birthday
        If Year(BDay) > 0 And Year(BDay) < 4000 Then
          Set UserProps = Contact.UserProperties
          Set Prop = UserProps.Item(Name)
          If Prop Is Nothing Then
            Set Prop = UserProps.Add(Name, olText, True)
          End If
          Prop.Value = Format(BDay, DateFormat)
          Contact.Save
        End If
      End If
    Next
  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.
email  Senden Sie eine Nachricht