Skipping first in recordset loop

[FNQChick]

I have the following code that loops through a recordset and sends meeting reminders to other users in outlook. It seems to work for the last record in the recordset and skips all the previous records. Can anyone see what I have done wrong. Cheers.

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
    
    Set objOutlook = CreateObject("Outlook.Application")
    Set db = CurrentDb
    Set rst = CurrentDb.OpenRecordset("qryTaskReminder")
    Set objAppt = CreateItem(olMeeting)
           

    rst.MoveLast
    rst.MoveFirst
       
Do Until rst.EOF
   With objAppt
    .MeetingStatus = olMeeting
    .Start = rst.Fields![Date_Due]
    .Duration = 0
    .Subject = "Task Due Reminder"
    .Body = "Project: " & rst.Fields![Project_Name] & vbCrLf _
    & "Task: " & rst.Fields![Action] & vbCrLf _
    & "Date Task Added: " & rst.Fields![Date_Added] & vbCrLf _
    & "Date Task is Due: " & rst.Fields![Date_Due] & vbCrLf _
    & "Responsibility of: " & rst.Fields![Responsible] & vbCrLf
    .ReminderSet = True
    .ReminderMinutesBeforeStart = 4320
    .ResponseRequested = True
    .OptionalAttendees = rst.Fields![Email].Value
    .Display
    End With
    
    rst.MoveNext
           
    Loop
     
    rst.Close
    Set rst = Nothing
    db.Close
    Set db = Nothing

Have a great day.

 

[MarkK]

You have only created one objAppt and each loop overwrites the previous loop's data in this object. The last record remains because it wasn't overwritten by the next loop.