Send reminder in Outlook to multiple recipients (1 Viewer)

Hello All,

I have a task database that I need to send reminders to multiple users from. I have most of the code working, but need some help.

1. I have a button and in the On-Click event I have placed my code.
My goal is that upon clicking the button the reminder will be added to Outlook for each of the email addresses listed in my form.

I can tell that the code is cycling through the email addresses because the reminders are being added to my calendar.

2. The issue is that I need the code to set my "AddedToOutlook" to True after each reminder is added and it is only setting the first record to True currently.

I am having trouble placing the code in the proper place to make this happen.

Any help and positive feedback would be greatly appreciated!





Here is the code that i have cobbled together.

Option Compare Database
Option Explicit

Private Sub AddAppt_Click()
On Error GoTo Add_Err
'Save record first to be sure the required fields are filled.
DoCmd.RunCommand acCmdSaveRecord


'Add a new reminder.



Dim objOutlook As New Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim stRecipient As String
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblAppointments")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF 'Loop until end of file
If Me!AddedToOutlook = True Then
MsgBox "This reminder has already been added to Microsoft Outlook"
rs.MoveNext
Else
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)

With objAppt
.MeetingStatus = olMeeting
stRecipient = rs!Email
.Start = Me!ApptDate & " " & Me!ApptTime1
.Duration = Me!ApptLength
.Subject = Me!Appt
.Body = "This email is auto generated from the Task Database. Please Do Not Reply"
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!Reminder1
.ReminderSet = True
End If



.Save
.Display 'Display reminder message in Outlook
'.Send 'Send reminder message without opening Outlook, silent sent behind the screen.
'rs.Update
'.Close (olSave)
End With

Set objAppt = Nothing 'Release the AppointmentItem object variable.
Set objOutlook = Nothing 'Release the Outlook object variable after releasing the AppointmentItem.

Me!AddedToOutlook = True ' Set the AddedToOutlook flag, save the record, display a message.
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"

rs.MoveNext
End If
Loop
End If


rs.Close 'Close record set.
Exit Sub

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

You're updating the record on the form; you want to update the record in the recordset.

rs.Edit
rs!FieldName = True
rs.Update

Thanks for the update.

I have made the following changes below and it cycles through each record and sets my "AddedToOutlook" to True which is exactly what i need.

Since I am running the code to display I was able to notice that when the email pops up it does not have the email address in the To box. Is this normal? Not sure since this is the first time i have done a reminder vs a straight email, but i would think the underlying concept should be the same.


I have included a sample in case that is easier.

Thanks again.






Option Compare Database
Option Explicit

Private Sub AddAppt_Click()
On Error GoTo Add_Err
'Save record first to be sure the required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

'Exit the procedure if the appoinment has been added to Outlook.


'Add a new reminder.

Dim objOutlook As New Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim stRecipient As String
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblAppointments")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF 'Loop until end of file
If rs!AddedToOutlook = True Then
MsgBox "This reminder has already been added to Microsoft Outlook"
rs.MoveNext
Else
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)

With objAppt
.MeetingStatus = olMeeting
stRecipient = rs!Email
.Start = rs!ApptDate & " " & rs!ApptTime1
.Duration = rs!ApptLength
.Subject = rs!Appt
.Body = "This email is auto generated from the Task Database. Please Do Not Reply"
If rs!ApptReminder Then
.ReminderMinutesBeforeStart = rs!Reminder1
.ReminderSet = True
End If




.Save
.Display 'Display reminder message in Outlook
'.Send 'Send reminder message without opening Outlook, silent sent behind the screen.
End With

Set objAppt = Nothing 'Release the AppointmentItem object variable.
Set objOutlook = Nothing 'Release the Outlook object variable after releasing the AppointmentItem.

rs.Edit
rs!AddedToOutlook = True ' Set the AddedToOutlook flag, save the record, display a message.
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
rs.Update

rs.MoveNext
End If
Loop
End If


rs.Close 'Close record set.
Exit Sub

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

This sets a variable, but you don't do anything with it:

stRecipient = rs!Email

I will investigate. Thanks for your help.

Ok. Got it working. Here is my final code. Hope it helps someone else.

Thanks for all of your help.


Option Compare Database
Option Explicit

Private Sub AddAppt_Click()
On Error GoTo Add_Err
'Save record first to be sure the required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

'Add a new reminder.
Dim objOutlook As New Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim stRecipient As String
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblAppointments")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF 'Loop until end of file
If rs!AddedToOutlook = True Then
MsgBox "This reminder has already been added to Microsoft Outlook"
rs.MoveNext
Else
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)


stRecipient = rs!Email

With objAppt
.MeetingStatus = olMeeting
.RequiredAttendees = stRecipient
.Start = rs!ApptDate & " " & rs!ApptTime1
.Duration = rs!ApptLength
.Subject = rs!Appt
.Body = "This email is auto generated from the Task Database. Please Do Not Reply"
If rs!ApptReminder Then
.ReminderMinutesBeforeStart = rs!Reminder1
.ReminderSet = True
End If


.Save
.Display 'Display reminder message in Outlook
'.Send 'Send reminder message without opening Outlook, silent sent behind the screen.
End With

Set objAppt = Nothing 'Release the AppointmentItem object variable.
Set objOutlook = Nothing 'Release the Outlook object variable after releasing the AppointmentItem.

rs.Edit
rs!AddedToOutlook = True ' Set the AddedToOutlook flag, save the record, display a message.
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
rs.Update

rs.MoveNext
End If
Loop
End If


rs.Close 'Close record set.
Exit Sub

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

Why not only look at records where AddedToOutlook is not set?

That msgbox is going to be shown more and more and will get annoying very quickly.

Happy to help!