Kontakte verwaltet in Excel in Outlook Kontakte schreiben

Falls Kontakte in Excel vorliegen, können diese via VBA Prozedur direkt in Outlook Kontakte geschrieben werden.

Voraussetzung ist folgende Excel Tabellenstruktur

--- BEGINN VBA Code

Public Sub Outlook_Kontakt_erstellen()

'Verweis auf Microsoft Outlook XX.X Object Library muß gesetzt sein


    Dim MyOutlook As Outlook.Application
    Dim KontaktOutlook As Outlook.ContactItem
    Dim i As Integer
    Set MyOutlook = CreateObject("Outlook.Application")

    ActiveSheet.Cells(1, 1).Activate
   'Spaltenbeschriftungen stehen in Zeile 1, Termine ab Zeile 2

   For i = 1 To ActiveSheet.UsedRange.Rows.Count
 
    If i <> 1 Then '1te Zeile = Spaltenbeschriftung überspringen
 
 
    Set KontaktOutlook = MyOutlook.CreateItem(olContactItem)
     
        With KontaktOutlook 'Excel Tabellenstruktur FirstName, LastName, BusinessAddress usw.
            .FirstName = ActiveSheet.Cells(i, 1).Value
            .LastName = ActiveSheet.Cells(i, 2).Value
            .BusinessAddress = ActiveSheet.Cells(i, 3).Value
            .BusinessAddressCountry = ActiveSheet.Cells(i, 4).Value
            .BusinessAddressPostalCode = ActiveSheet.Cells(i, 5).Value
            .BusinessAddressState = ActiveSheet.Cells(i, 6).Value
            .Email1Address = ActiveSheet.Cells(i, 7).Value
            .HomeTelephoneNumber = ActiveSheet.Cells(i, 8).Value
            .BusinessTelephoneNumber = ActiveSheet.Cells(i, 9).Value
            .BusinessFaxNumber = ActiveSheet.Cells(i, 10).Value
            .MobileTelephoneNumber = ActiveSheet.Cells(i, 11).Value
    '        .Birthday = "TT.MM.JJJJ"
    '        .WebPage = "http://www.musterseite.de"
            .Save
        End With
     
        Set KontaktOutlook = Nothing
     
     
    End If
 
    Next i

    Set MyOutlook = Nothing
 
End Sub

--- ENDE VBA Code