Public objOutlook As New Outlook.Application
Public objFolderAdr As MAPIFolder
Public Item As ContactItem
 
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolderAdr = objNameSpace.GetDefaultFolder(olFolderContacts)
 
do while RS.eof = False
 
    Set Item = objFolderAdr.Items.Add
    Item.LastName = RS!Name
    Item.Email1Address = RS!EMail
    Item.Save
 
    RS.MoveNext
Loop