Looping through Outlook Calendar Items in VBA (MS Access)

Our team uses a custom built task management software built in MS Access.  We also import appointments from Outlook into the database since there are a lot of meetings that need to be included in our time management reporting to Sr. Leadership of the team,

Up until now the code below has worked relatively well.  But, now it is suddenly not working for me and a few other people.  It is erroring out on the line "For Each itm in Itms" as a type mis-match error.  To make matters more interesting, it errors out the first time through and then will work the next time.  The third time it will fail.  The forth time it will work, etc.

We are running MS Access 2003 and MS Outlook 2003 (both with SP3) remoted into our team server that are running Windows Server 2008.

Public Sub GrabAppointments(dteStart As Date, dteEnd As Date)

Dim OUT As Outlook.Application
Dim itms As Outlook.Items
Dim itm As Outlook.AppointmentItem
Dim strLoggedIn As String
Dim ns As Outlook.NameSpace
Set OUT = New Outlook.Application
Set ns = Outlook.GetNameSpace("MAPI")
Dim rst As New ADODB.recordset
Dim rstTarget As New ADODB.recordset
Dim dteMax As Date  'stores latest event with Project assignment
Dim intCount As Long 'to count current appointments

strLoggedIn = LoggedIn()
If ns.CurrentUser = DLookup("OutlookUserName", "tblUsers", "User='" & strLoggedIn & "'") Then

    DoCmd.RunSQL "Delete * FROM tblTempAppointments;"
    rst.Open "Select * FROM tblTempAppointments", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    Set itms = ns.GetDefaultFolder(olFolderCalendar).Items
        itms.IncludeRecurrences = True
        itms.Sort "[Start]"
    Set itms = itms.Restrict("[Start] >= '" & Format(dteStart, "mm/dd/yyyy") & "' AND [End] <='" & Format(dteEnd, "mm/dd/yyyy") & "'")
   
    '*** The Next Line is erroring out *******
   
    For Each itm In itms
        If itm.Sensitivity <> olPrivate Then
            rst.AddNew
                rst("RAT") = strLoggedIn
                rst("OutlookID") = itm.EntryID
                rst("StartDate") = Format(itm.Start, "mm/dd/yyyy")
                rst("EndDate") = IIf(itm.AlLDayEvent = True, Format(itm.End - 1, "mm/dd/yyyy"), Format(itm.End, "mm/dd/yyyy"))
                rst("StartTime") = Format(itm.Start, "h:m")
                rst("EndTime") = IIf(itm.AlLDayEvent = True, "11:59", Format(itm.End, "h:m"))
                rst("BusyStatus") = TranslateOlBusyStatus(itm.BusyStatus)
                Select Case itm.Sensitivity
                    Case olConfidential
                        rst("Subject") = "Confidential Appointment"
                        rst("Location") = ""
                    Case olNormal
                        rst("Subject") = itm.Subject
                        rst("Location") = itm.Location
                    Case olPersonal
                        rst("Subject") = "Personal Appointment"
                        rst("Location") = ""
                    Case olPrivate
                        rst("Subject") = "Private Appointment"
                        rst("Location") = ""
                End Select
                rst("AlLDayEvent") = itm.AlLDayEvent
            rst.Update
        End If
    Next
    Set rst = Nothing

********* Code that does that uses the new data to update the existing data via ADO recordsets ***********

Set OUT = Nothing
Set ns = Nothing
Set itms = Nothing
Set itm = Nothing
Set rst = Nothing

Any help would be greatly appreciated.

Thanks,

Amy Young