Ich hätte da mal eine Frage. Mit nachfolgenden Makro (habe ich in der Recherche gefunden) übertrage ich Kontaktdaten aus Excel nach Outllook.
Sub Adressen_Tabelle1()
Dim Outlook As Outlook.Application
Dim Outlookname As Outlook.Namespace
Dim Kontaktordnernummer As Outlook.MAPIFolder
Dim Outlookkontakt As Outlook.ContactItem
Dim Eintragnummer As Integer
If ActiveSheet.Name = "Tabelle1" Then
Set Outlook = CreateObject("Outlook.Application")
Set Outlookname = Outlook.GetNamespace("MAPI")
Set Kontaktordnernummer = Outlookname.Folders(2).Folders("Kontakte")
For Eintragnummer = 3 To Cells(Rows.Count, 6).End(xlUp).Row
If Cells(Eintragnummer, 6) <> "" Then
Set Outlookkontakt = Kontaktordnernummer.Items.Add
'Firmenname
Outlookkontakt.CompanyName = Range("C" & Eintragnummer).Value
'Anrede
Outlookkontakt.Title = Range("D" & Eintragnummer).Value
'Nachname
Outlookkontakt.LastName = Range("F" & Eintragnummer).Value
'Vorname
Outlookkontakt.FirstName = Range("G" & Eintragnummer).Value
'Strasse
Outlookkontakt.BusinessAddressStreet = Range("I" & Eintragnummer).Value
'Postleitzahl
Outlookkontakt.BusinessAddress = Range("J" & Eintragnummer).Value
'Stadt
Outlookkontakt.BusinessAddressCity = Range("K" & Eintragnummer).Value
'Firmentelefonnummer
Outlookkontakt.BusinessTelephoneNumber = Range("L" & Eintragnummer).Value
'Mobilfunknummer
Outlookkontakt.MobileTelephoneNumber = Range("M" & Eintragnummer).Value
'Faxnummer
Outlookkontakt.BusinessFaxNumber = Range("N" & Eintragnummer).Value
'Homepage
Outlookkontakt.BusinessHomePage = Range("O" & Eintragnummer).Value
'E-Mailadresse
Outlookkontakt.Email1Address = Range("P" & Eintragnummer).Value
'Bemerkungen
Outlookkontakt.Body = Range("Q" & Eintragnummer).Value
'Geburtstag
Outlookkontakt.Birthday = Range("Z" & Eintragnummer).Value
'Kontakteintrag in Outlook speichern
Outlookkontakt.Save
Set Outlookkontakt = Nothing
End If
Next
Set Kontaktordnernummer = Nothing
Set Outlookname = Nothing
Set Outlook = Nothing
End If
End Sub
Das funktioniert alles wunderbar. Allerdings hat die ganze Sache einen Haken. Besteht bereits ein Kontakt, wird dieser erneut angelegt. Gibt es eine Möglichkeit dieses zu verhindern, so dass nur Kontakte, die es noch nicht in dem Outlookadressbuch gibt, übertragen werden?
Danke Euch für die Hilfe und Gruß,
Kasimir