Export von Outlook Kontakten nach Excel per VBA Makro

Problem:
In manchen Fällen ist es notwendig, die Outlook Kontakte in eine Excel-Tabelle zu exportieren. Will man das nun häufiger machen, kann es recht aufwändig sein, jedes Mal die Exportfunktion erneut aufzurufen. In diesem Fall wäre es schön ein Makro zu haben, das man von Outlook aus einfach aufruft und diese Arbeit erledigt.

Lösung:
Das folgende Makro wird einfach in Outlook als Makro hinterlegt. Wird das Makro aufgerufen, so erstellt es vollautomatisch eine Excel-Datei (diese wird auch angezeigt) und füllt diese mit den gewünschten Spalten.

Wenn Sie wissen wollen, welche Spaltennamen Sie verwenden können, dann schauen Sie bitte hier nach:
wie-heissen-outlook-kontakte-spaltennamen-auf-englisch

Sub KontakteExportieren()
   
    On Error Resume Next

    Const olFolderContacts = 10

    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")

    Set colContacts = objNamespace.GetDefaultFolder(olFolderContacts).Items

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    objExcel.Cells(1, 1) = "Name"
    objExcel.Cells(1, 2) = "Business Phone"
    objExcel.Cells(1, 3) = "FirstName"
    objExcel.Cells(1, 4) = "LastName"

    i = 4

    For Each objContact In colContacts
        objExcel.Cells(i, 1).Value = objContact.FullName
        objExcel.Cells(i, 2).Value = objContact.BusinessTelephoneNumber
        objExcel.Cells(i, 3).Value = objContact.FirstName
        objExcel.Cells(i, 4).Value = objContact.LastName
        i = i + 1
    Next

    Set objRange = objWorksheet.UsedRange
    objRange.EntireColumn.Autofit
    
End Sub

Hinweis:
Wenn weitere Spalten hinzugefügt werden sollen, so können diese einfach ergänzt werden, indem nach der Zeile

 objExcel.Cells(1, 4) = "LastName"\\ 

eine weitere Zeile eingefügt wird und die zweite Zahl um eins erhöht wird, also z.B.

 objExcel.Cells(1, 5) = "NameDesFeldes"\\ 

Außerdem der Zähler

  i = 4\\ 

um eins erhöht wird auf

  i = 5\\ 

Und nach der Zeile

  objExcel.Cells(i, 4).Value = objContact.LastName

eine weitere Zeile eingefügt wird und die zweite Zahl um eins erhöht wird, also z.B.

  objExcel.Cells(i, 5).Value = objContact.NameDesFeldes