importing from Outlook to Access or vice versa

  • Thread starter Thread starter Michelle
  • Start date Start date
M

Michelle

My question is this:

I am working for someone and they want names and
addresses in an Access database. Great. Done that. Real
new to Access, but did it. Then I have to put the same
info in her Outlook Contacts list. Is there anyway to
pull the information from one to the other without having
to type it twice? I asked a teacher of Access and she did
not know. But it is very time consuming to type all that
twice. Please help!!!


Michelle
 
You can use Automation to export contact data from Access to Outlook. To
use the code below, you will need to add a reference to the Microsoft
Outlook xx.x Object Library (where xx.x is the version you are using) and
the Microsoft DAO x.xx Object Library (where x.xx is the version appropriate
to your version of Access).

You will need, of course, to change the table and field names found here to
match the ones you are using.

Dim oOutlook As New Outlook.Application
Dim colItems As Items
Dim rsCont As DAO.Recordset
Dim db as DAO.Database
Dim strSQL As String
Dim strMsg As String

strSQL = "Select * from tblContacts;"

Set db = CurrentDB
Set rsCont = db.OpenRecordset(strSQL, dbOpenDynaset)

'Get a reference to the Items collection of the contacts folder.
Set colItems = oOutlook.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderContacts).Items
rsCont.MoveFirst
Do Until rsCont.EOF
With colItems.Add
.Email1Address = Nz(rsCont!emailaddr)
.FirstName = Nz(rsCont!ContactFirstName)
.LastName = Nz(rsCont!ContactLastName)
.BusinessAddressStreet = Nz(rsCont!BusinessAddress, "")
.FullName = Nz(rsCont!ContactName)
.BusinessAddressCity = Nz(tblContacts!City)
.BusinessAddressState = Nz(tblContacts!Region)
.BusinessAddressPostalCode = Nz(tblContacts!PostalCode)
.BusinessAddressCountry = Nz(tblContacts!Country)
.BusinessTelephonePhone = Nz(tblContacts!Phone)
.BusinessFaxNumber = Nz(tblContacts!Fax)
.CompanyName = Nz(tblContacts!CompanyName)
.JobTitle = Nz(tblContacts!ContactTitle)

.Save
End With
rsCont.MoveNext
Loop
rsCont.Close
Set rsCont=Nothing
MsgBox "Done!"


hth,
 
Back
Top