Option Explicit
 
Public Sub AddContacts()
 
Dim objApp As Outlook.Application                   'Application-Objekt von 
' Outlook
Dim objContact As Outlook.ContactItem               'Contact-Item von Outlook
 
 
Dim i As Integer                                            'Zählervariable
 
'Form aufrufen
Kontaktimport_Status.Show vbModeless
 
Kontaktimport_Status.lbl_Meldung = "Daten werden vorbereitet..."
 
 
Set objApp = New Outlook.Application
 
 
Kontaktimport_Status.lbl_Meldung = "Kontakte werden importiert... Bitte warten!"
 
 
i = 0
 
Do While rst.EOF = False
 
 
    'neuen Kontakt erstellen
    Set objContact = objApp.CreateItem(olContactItem)
 
 
    Kontaktimport_Status.lbl_Zaehler = i
 
    i = i + 1
 
Loop
 
End Sub