Bill Garrett
June 20th, 2001, 08:35 AM
Hello everyone. I am writing a simple program that takes the records in an MS Access database, and dumps them into the Contacts folder in MS Outlook. The code works fine, but when the user runs the code a 2nd time, it dumps all the records into the folder again, making duplicates. I wanted to know if anyone knew some code I could add to it that would check the contacts folder prior to copying, and would not copy over a name already in the folder. I'm attaching the original code. Any help is greatly appreciated!
Thanks,
Bill Garrett
poc301@hotmail.com
-------------------------------------------------
Function BatchUpload()
' Setup DAO Database Schtuffins.
Dim oDataBase As DAO.Database
Dim rst As DAO.Recordset
Set oDataBase = OpenDatabase _
("K:\Bill Garrett\sulphur DB\sulphur.mdb")
Set rst = oDataBase.OpenRecordset("Contacts")
' Setup Outlook Schtuffins.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
With rst
.MoveFirst
' Loop through Sulphur's records.
Do While Not .EOF
' Create new Contact item.
Set c = ol.CreateItem(olContactItem)
' Specify form
c.MessageClass = "IPM.Contact"
' Create all prebuilt Outlook fields and make associations
If ![COMPANY] <> "" Then c.CompanyName = ![COMPANY]
If ![F_NAME] & ![L_NAME] <> "" Then c.FULLNAME = ![F_NAME] & " " & ![L_NAME]
' Create the first property (UserField1) and give value
Set Prop = c.UserProperties.Add("UserField1", olText)
If ![CONTACT_ID] <> "" Then Prop = ![CONTACT_ID]
' Create the second user property (UserField2) and give value
Set Prop = c.UserProperties.Add("UserField2", olText)
If ![REGION] <> "" Then Prop = ![REGION]
' Save and close the contact.
c.Save
' c.Close -Can't close or I get an error?
.MoveNext
Loop
End With
End Function
Thanks,
Bill Garrett
poc301@hotmail.com
-------------------------------------------------
Function BatchUpload()
' Setup DAO Database Schtuffins.
Dim oDataBase As DAO.Database
Dim rst As DAO.Recordset
Set oDataBase = OpenDatabase _
("K:\Bill Garrett\sulphur DB\sulphur.mdb")
Set rst = oDataBase.OpenRecordset("Contacts")
' Setup Outlook Schtuffins.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim Prop As Outlook.UserProperty
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
With rst
.MoveFirst
' Loop through Sulphur's records.
Do While Not .EOF
' Create new Contact item.
Set c = ol.CreateItem(olContactItem)
' Specify form
c.MessageClass = "IPM.Contact"
' Create all prebuilt Outlook fields and make associations
If ![COMPANY] <> "" Then c.CompanyName = ![COMPANY]
If ![F_NAME] & ![L_NAME] <> "" Then c.FULLNAME = ![F_NAME] & " " & ![L_NAME]
' Create the first property (UserField1) and give value
Set Prop = c.UserProperties.Add("UserField1", olText)
If ![CONTACT_ID] <> "" Then Prop = ![CONTACT_ID]
' Create the second user property (UserField2) and give value
Set Prop = c.UserProperties.Add("UserField2", olText)
If ![REGION] <> "" Then Prop = ![REGION]
' Save and close the contact.
c.Save
' c.Close -Can't close or I get an error?
.MoveNext
Loop
End With
End Function