having problem saving from data in outlook contact

[neerajam]

I have a form that contains all my soccer player data. I would like to save the same in outlook contacts. I have used the following code to do the same. However, I am able to input only 1 record and that record alone. Can you help me out. Thanks.

Dim db As Database
Dim rsdata As Recordset
Dim objoutlook As Outlook.Application
Dim objcontactitem As Outlook.ContactItem
Dim i As Integer
Set db = CurrentDb
Set rsdata = db.OpenRecordset("tblplayers")

Set objoutlook = New Outlook.Application
Set objcontactitem = objoutlook.CreateItem(olContactItem)
Do Until rsdata.EOF
With objcontactitem
.FullName = rsdata("lastname") & " " & rsdata("firstname")
.HomeAddress = rsdata("address")
.HomeAddressCity = rsdata("city")
.HomeAddressState = rsdata("state")
.HomeAddressPostalCode = rsdata("zip")
.HomeTelephoneNumber = rsdata("phone")
.Save
End With

rsdata.MoveNext
Loop

 

[AnnabelleMarie]

It looks like to me that you are only creating one objcontactitem, so it just keeps overwriting the one contact until it gets thru all of the records and then the contact that you are left with is probably the last record. Try putting the line set objcontactitem = objoutlook.CreateItem(olContactItem) before the with objcontactitem so that this line is in the loop. Then it will create a contact object for each record. Don't forget to set each objoutlook to nothing when you are done with it, so you don't have a memory problem. I've never worked with Outlook in Access before, so I'm not positive about this, but it wouldn't hurt to try it to see if it works. Hope I helped you!

 

[PHV]

AnnabelleMarie is on the target:
Dim db As Database
Dim rsdata As DAO.Recordset
Dim objoutlook As Outlook.Application
Dim objcontactitem As Outlook.ContactItem
Set db = CurrentDb
Set rsdata = db.OpenRecordset("tblplayers")
Set objoutlook = New Outlook.Application
Do Until rsdata.EOF
Set objcontactitem = objoutlook.CreateItem(olContactItem)
With objcontactitem
.FullName = rsdata("lastname") & " " & rsdata("firstname")
.HomeAddress = rsdata("address")
.HomeAddressCity = rsdata("city")
.HomeAddressState = rsdata("state")
.HomeAddressPostalCode = rsdata("zip")
.HomeTelephoneNumber = rsdata("phone")
.Save
End With
Set objcontactitem = Nothing
rsdata.MoveNext
Loop
Set objoutlook = Nothing
rsdata.Close
Set rsdata = Nothing
Set db = nothing

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244