Ich möchte Daten aus einer Tabelle in das Outlook-Adressbuch übertragen. Bisher habe ich folgendes Macro:
<pre>
Private Sub CommandButton1_Click()
Dim trOlApp As New Outlook.Application
Dim trNamespace As Outlook.Namespace
Dim trFolder As Outlook.MAPIFolder
Dim trItem As Outlook.ContactItem
Dim trArre As Worksheet
Dim wsReser As Worksheet
Set trArre = ThisWorkbook.Sheets("Archiv-Reser")
Set trNamespace = trOlApp.GetNamespace("MAPI")
Set trFolder = trNamespace.GetDefaultFolder(olFolderContacts).Folders("Pension")
Set trItem = trFolder.Items.Add
Set trattachments = trItem.Attachments
Rem Stop
With trItem
.FileAs = trArre.Range("N2") & " " & trArre.Range("M2")
.FullName = trArre.Range("M2") & " " & trArre.Range("N2")
.Body = trArre.Range("V2")
.BusinessAddress = trArre.Range("N2")
.BusinessAddressCity = trArre.Range("S2")
.BusinessAddressPostalCode = trArre.Range("R2")
.BusinessAddressStreet = trArre.Range("Q2")
.BusinessFaxNumber = trArre.Range("X2")
.BusinessTelephoneNumber = trArre.Range("W2")
.CompanyName = trArre.Range("P2")
.Email1Address = trArre.Range("T2")
.Email1DisplayName = trArre.Range("M2") & " " & trArre.Range("N2")
.Save
End With
End Sub</pre>
Jetzt einige Fragen dazu:
Wie ich das herausgelesen habe ist die Funktion .Attachment für das hinzufügen von Anlagen zuständig. Ich bekomme es aber nicht hin, eine auf Festplatte abgespeicherte Datei dem Kontakt mit hinzuzufügen. Wie wird dieser Befehl in diesem Fall angewandt?
Weiterhin möchte ich das Macro dazu bringen, dass es vor dem Eintrag ins Adressbuch überprüft, ob es diesen Eintrag schon gibt. Wenn ja, soll er nur die fehlenden Daten ergänzen und die Anlage hinzufügen. Wie stellt man das am dümmsten an? Dafür habe ich gar keine Funktion gefunden.
Danke,
Thomas