Article ID: 180981
Article Last Modified on 11/24/2006
Sub ExportAccessContactsToOutlook()
' Set up DAO Objects.
Dim oDataBase As Object
Dim rst As Object
Set oDataBase = OpenDatabase _
("c:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb")
Set rst = oDataBase.OpenRecordset("Customers")
' Set up Outlook Objects.
Dim olns As Object ' Outlook Namespace.
Dim cf As Object ' Contact folder.
Dim c As Object ' Contact item.
Dim Prop As Object ' User property.
Dim ol As New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
With rst
.MoveFirst
' Loop through the Microsoft Access records.
Do While Not .EOF
' Create a new Contact item.
Set c = ol.CreateItem(olContactItem)
' Specify which Outlook form to use.
' Change "IPM.Contact" to "IPM.Contact.<formname>" if you've
' created a custom Contact form in Outlook.
c.MessageClass = "IPM.Contact"
' Create all built-in Outlook fields.
If ![CompanyName] <> "" Then c.CompanyName = ![CompanyName]
If ![ContactName] <> "" Then c.FullName = ![ContactName]
' Create the first user property (UserField1).
Set Prop = c.UserProperties.Add("UserField1", olText)
' Set its value.
If ![CustomerID] <> "" Then Prop = ![CustomerID]
' Create the second user property (UserField2).
Set Prop = c.UserProperties.Add("UserField2", olText)
' Set its value and so on....
If ![Region] <> "" Then Prop = ![Region]
' Save the contact.
c.Save
.MoveNext
Loop
End With
End Sub
Additional query words: OutSol OutSol98
Keywords: kbcode kbhowto kbprogramming KB180981