Sub Initialize
   Dim ses As New NotesSession   
   Dim TelDB As NotesDatabase
   Dim AdrDB As NotesDatabase
   Dim col As NotesDocumentCollection
   Dim Teldoc As NotesDocument
   Dim Adrdoc As NotesDocument
   
   Set TelDB = ses.CurrentDatabase
   Set col = TelDB.UnprocessedDocuments
   Set Teldoc = col.GetFirstDocument
   Set AdrDB = ses.GetDatabase ("", "names.nsf", False)
   Set Adrdoc = AdrDB.CreateDocument
   
   While Not(Teldoc Is Nothing)
      With Adrdoc
         .Form = "Kontakt"
         .Type = "Person"
         .PhoneLabel_6 = "Kurzwahl aus Achim"
         .FirstName = Teldoc.vorname
         .LastName = Teldoc.name
         .Title = Teldoc.titel
         .OfficePhoneNumber = Teldoc.rufnummer
         .OfficeFAXPhoneNumber = Teldoc.fax
         .CellPhoneNumber = Teldoc.mobil
         .PhoneNumber_6 = Teldoc.Kurzwmobil
         .CompanyName = Teldoc.Unternehmen
         .MailAdress = Teldoc.mail
      End With
      
      Call Adrdoc.Save (True, False)
      Set Adrdoc = AdrDB.CreateDocument
      Set Teldoc = col.GetNextDocument (Teldoc)
   Wend
   
End Sub