VBOffice

Email mit Kontaktdaten verknüpfen

Dieses Beispiel zeigt, wie Sie bei Emaileingang den Absender suchen und die Kontaktdaten im Posteingang anzeigen können.

Zuletzt geändert: 30.03.2015 | Aufrufe: 27.130  | #143
◀ Vorheriges Beispiel Nächstes Beispiel ▶
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.

Wenn Sie eine Email von jemanden erhalten, dessen Kontaktdaten Sie gespeichert haben, verknüpft Outlook die Email nicht mit den Kontaktdaten. Darum ist es z.B. nicht möglich, im Posteingang den Vor- und Nachnamen oder Firmennamen anzuzeigen.

Die folgenden VBA-Funktionen suchen die Emailadresse des Absenders im Kontakteordner und fügen der Email benutzerdefinierte Felder hinzu, in welchen die Kontaktdaten geschrieben werden. Angestoßen wird das automatisch, sobald dem Standardposteingang eine Email hinzugefügt wird. Nachdem die erste Email vom Makro bearbeitet wurde, können Sie die neuen Felder dann im Ordner über Anpassen der Ordneransicht sichtbar machen.


tip  So fügen Sie Makros in Outlook ein
Private WithEvents m_Inbox As Outlook.Items
Private m_Contacts As Outlook.Items

Friend Sub Application_Startup()
  Set m_Inbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub m_Inbox_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    Set m_Contacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
    UpdateEmail Item
  End If
End Sub

Private Sub UpdateEmail(Mail As Outlook.MailItem)
  Dim Contact As Outlook.ContactItem
  Dim Props As Outlook.UserProperties
  Dim Prop As Outlook.UserProperty
  Dim Name As String
  
  Set Contact = GetContact(Mail.SenderEmailAddress)
  If Not Contact Is Nothing Then
    Set Props = Mail.UserProperties
    
    Set Prop = GetUserProperty(Props, "AbsenderName")
    Prop.Value = Contact.Fullname
    
    Set Prop = GetUserProperty(Props, "AbsenderFirma")
    Prop.Value = Contact.CompanyName
    
    Mail.Save
  End If
End Sub

Private Function GetUserProperty(Props As Outlook.UserProperties, Name As String) As Outlook.UserProperty
  Dim Prop As Outlook.UserProperty
  Set Prop = Props.Find(Name)
  If Prop Is Nothing Then
    Set Prop = Props.Add(Name, olText, True)
  End If
  Set GetUserProperty = Prop
End Function

Private Function GetContact(Adr As String) As Outlook.ContactItem
  Dim Contact As Outlook.ContactItem
  Set Contact = m_Contacts.Find("[Email1Address]='" & Adr & "'")
  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email2Address]='" & Adr & "'")
  End If
  If Contact Is Nothing Then
    Set Contact = m_Contacts.Find("[Email3Address]='" & Adr & "'")
  End If
  Set GetContact = Contact
End Function
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.

Und hier kommt noch eine Funktion, die Sie manuell, z.B. über F8, aufrufen können. Diese aktualisiert alle Emails im aktuellen Ordner; das muss nicht zwingend der Posteingang sein. Das ist z.B. dann nützlich, wenn sich die Kontaktdaten geändert haben und Sie alle Emails auf den neuesten Stand bringen wollen.

Public Sub UpdateAllEmails()
  Dim Item As Object
  Dim Folder As Outlook.MAPIFolder
  
  Set Folder = Application.ActiveExplorer.CurrentFolder
  If Folder.DefaultItemType = olContactItem Then
    MsgBox "Wählen Sie einen Ordner, der keine Kontakte enthält"
    Exit Sub
  End If
  
  Set m_Inbox = Folder.Items
  Set m_Contacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
  
  For Each Item In m_Inbox
    If TypeOf Item Is Outlook.MailItem Then
      UpdateEmail Item
    End If
  Next
  MsgBox "Update erledigt"
End Sub
Reporter Reporter
Mit dem Reporter erstellen Sie Berichte für Ihre Outlook Daten. Mit wenigen Klicks werden Werte aus Aufgaben, Terminen und dem Journal summiert.
email  Senden Sie eine Nachricht