title image


Smiley Das macht folgendes Programm




Sub OutlookKontaktHinzufügen()



' Fügt Kontakte in Outlook ein



Const SQLselect As String = "SELECT * FROM T_Adressen"



Dim rst As DAO.Recordset



Dim olAppl As Object

Dim olNS As NameSpace

Dim olMAPIFolder As MAPIFolder

Dim olKontakt As ContactItem



Set rst = CurrentDb.OpenRecordset(SQLselect)



If rst.RecordCount > 0 Then



Set olAppl = CreateObject("Outlook.Application")

Set olNS = olAppl.GetNamespace("MAPI")

Set olMAPIFolder = olNS.GetDefaultFolder(olFolderContacts)



rst.MoveFirst



Do While Not rst.EOF



Set olKontakt = olMAPIFolder.Items.Add



With olKontakt

.FirstName = rst!Vorname

.LastName = rst!Nachname

.HomeAddressStreet = rst!Strasse

.HomeAddressCity = rst!Wohnort

.Save

End With



rst.MoveNext



Loop



Set olKontakt = Nothing

Set olMAPIFolder = Nothing

Set olNS = Nothing

Set olAppl = Nothing



End If





Greetz,

Eric

Spotlight-Kicktipp gestartet!

Steig ein und trete mit Deinem Bundesliga-Tipp gegen die Besten an! :o)

http://www.kicktipp.de/spotlight/



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: