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
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