PflebIT - Pflegeinformatik in der Praxis

Diese Seite ist nicht editierbar. Sie können den Quelltext sehen, jedoch nicht verändern. Kontaktieren Sie den Administrator, wenn Sie glauben, dass hier ein Fehler vorliegt.
====== 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:\\ 
[[kb:software:outlook:wie-heissen-outlook-kontakte-spaltennamen-auf-englisch|]]

<code>

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


</code>

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