Whoops! I posted this earlier in the wrong newsgroup: I am writing a routine that will Outlook Appointment items and write them into a database. When an item is recorded, I write the ID created in Access into a custom field in the appointment item. This is kinda working, but there are some strange issues. I have 22 items in the Calendar. My filter is looking for the past 10 days and the next 10 days, so there will be additional items based on recurrence. On the last run I did, 28 items were created. #1 - When I view the custom field in Outlook, only 3 of the 22 items show the ID that I wrote, yet on a second run where I check to see if the items have an ID, they do. Why then, are they not showing? #2 - When I run this a second time, 3 items are added again. These are not the same items from issue #1 As for why we are doing it this way rather than just linking to the calendar items, The user also needs to view the data while offline. Thank you. Public Function ImportCalendar_TEST() 'Access Calendar items (Past 10 days, Next 10 days 'Add Access-Created Calendar ID 'If Calendar ID field has a value, compare CORE fields values on ietsm with matching ID, date, & time '''If changes then save make a copy of existing values, save new values '''If No ID, add record; record Access ID in Calendar 'OUTLOOK Dim objFPRecip As Outlook.Recipient Dim SafeAppointment, oAppointment Dim olOutlook As Outlook.Application Dim nsNameSpace As NameSpace Dim mItemCollection As Items Dim myItems As Items 'ACCESS Dim dbMain As DAO.Database Dim rsAppointment As DAO.Recordset 'OTHER Dim sFilter As String Dim lAppID As Long sFilter = "[End] >= '" & Format(Date - 10, "yyyy/mm/dd") & "' AND [Start] <= '" & Format(Date + 10 & " 11:59 PM", "yyyy/mm/dd hh:nn") & "'" 'LOCAL Set olOutlook = CreateObject("Outlook.Application") Set nsNameSpace = olOutlook.GetNamespace("MAPI") Set myItems = nsNameSpace.GetDefaultFolder(olFolderCalendar).Items myItems.Sort "[Start]", False myItems.IncludeRecurrences = True Set mItemCollection = myItems.Restrict(sFilter) Set dbMain = CurrentDb ' LOOP OF CALENDAR ITEMS *************************************************************************** ****************** For Each Item In mItemCollection 'APPOINTMENT CHECK If Item.Class = olAppointment Then Set SafeAppointment = CreateObject("Redemption.SafeAppointmentItem") Set oAppointment = Item SafeAppointment.Item = oAppointment If Not IsNumeric(SafeAppointment.UserProperties.Find("APPID")) Then 'Appointment was never added. Add Appointment to Database SafeAppointment.UserProperties.Add "APPID", olText, True Set rsAppointment = dbMain.OpenRecordset("SELECT * FROM Appointment_TBL;") rsAppointment.AddNew rsAppointment("EntryID") = SafeAppointment.EntryID rsAppointment.Fields("Start") = SafeAppointment.Start rsAppointment.Fields("StartDate") = Format(SafeAppointment.Start, "mm-dd-yyyy") rsAppointment.Fields("StartTime") = Format(SafeAppointment.Start, "hh:nn ampm") rsAppointment.Fields("End") = SafeAppointment.End rsAppointment.Fields("EndDate") = Format(SafeAppointment.End, "mm/ dd/yyyy") rsAppointment.Fields("EndTime") = Format(SafeAppointment.End, "hh:nn AMPM") rsAppointment("ConversationTopic") = SafeAppointment.ConversationTopic rsAppointment("Subject") = SafeAppointment.Subject rsAppointment("Body") = SafeAppointment.Body 'Add Access ID to Outlook SafeAppointment.UserProperties.Find("APPID") = rsAppointment("Appointment_ID") SafeAppointment.Save rsAppointment.Update Set rsAppointment = Nothing Debug.Print SafeAppointment.UserProperties.Find("APPID") & ": Created" Else Debug.Print SafeAppointment.UserProperties.Find("APPID") & ": Already Exists" End If Set SafeAppointment = Nothing End If Next ' END LOOP *************************************************************************** ************************* End Function