Adding new appointments deletes the previous one

[Max]

Something weird here.
I am looping through a recordset and creating appointments in Outlook. As I step through, I can see that it creates the appointment ok, but it deletes/removes the previous one it created.

It makes no difference if I go into Outlook after each creation and then open/save the appointment, on the next loop it is deleted as the new one is created.

Does anybody know why it does this and how to overcome it?

Code: Select all

Public Sub AddCalendarEntry()
    Dim dbs As DAO.Database, rst As DAO.Recordset, sql As String, sql2 As String
    Dim oA As Outlook.AppointmentItem
    Set oA = Outlook.CreateItem(olAppointmentItem)
    Set dbs = CurrentDb
    sql = "Select * from diaryqry WHERE PostedToCalendar=false"
    Set rst = dbs.OpenRecordset(sql)
    rst.MoveFirst
    Do While Not rst.EOF
        sql = "#" & Mid(rst!DiaryDate, 4, 3) & Left(rst!DiaryDate, 3) & Mid(rst!DiaryDate, 7) & " " & rst!TimeStart & "#"
        sql2 = "#" & Mid(rst!DiaryDate, 4, 3) & Left(rst!DiaryDate, 3) & Mid(rst!DiaryDate, 7) & " " & rst!TimeEnd & "#"
        Debug.Print sql
        With oA
            .Subject = rst!Reason
            .Body = rst!Problem & vbCrLf & _
                    rst!Location & vbCrLf & _
                    rst!Person & vbCrLf & _
                    rst!Org & vbCrLf & _
                    rst!Notes
            .ReminderMinutesBeforeStart = 60
            .ReminderSet = True
            '.ReminderOverrideDefault = True
            .Start = Eval(sql)
            .End = Eval(sql2)
            '            .ShowCategoriesDialog
            '             MsgBox oA.Categories
            .Categories = "Imported From Diary.mdb"
            '.Display
            .Save
        End With

        rst.Edit
        rst!PostedToCalendar = True
        rst.Update
        Stop
        rst.MoveNext
    Loop
exithere:
    Set dbs = Nothing: Set rst = Nothing
    Exit Sub
End Sub

[Max]

AHA! Figured it out.

I needed to put the line

Code: Select all

Set oA = Outlook.CreateItem(olAppointmentItem)

INSIDE the loop.
It was using the same appointmentitem each time instead of creating a new one.

[HansV]

You have to create the appointment item within the loop, otherwise you work with a single appointment all the time. So move the line

Code: Select all

    Set oA = Outlook.CreateItem(olAppointmentItem)

to below the line

Code: Select all

    Do While Not rst.EOF

Added: ah - you found it yourself!

[Max]

Yes, sorry for wasting your time. I stared at it a long time before it dawned on me what the problem was.
Regards