Hello All!
I have been working away on a project and I am at a stopping point and would love help if anyone has insight on this. Here is the current Macro that I have. This will take an appointment and when ran will create an email to remind the client of their appointment including detail. Currently, it is successfully pulling/generating the email that I want to be sent.
The issue that I am having is that I want to have the email recipient field to pull from the appointment location field (we put the email address in the location field).
If any of you might be able to help or give me suggestions it would be greatly appreciated as I cannot figure it out.
Thank you!
Sub SendMeetingReminder()
'On the next line change True to False if you want the reminder to send without giving you the chance to edit it.
'Leave it set to True if you want an opportunity to edit the message before sending it.
Const EDIT_FIRST = True
'On the next line edit the message as desired. Both %START% and %LOCATION% are parameters that will be replaced
'with the meeting start time and location respectively before the message is displayed/sent.
Const MSG_TEXT = "Hello,<br><br>You have an upcoming appointment at Accounting and Tax Services.<br><br>Start: <b>%START%</b><br>Location: <b>(Blank for Online)
</b><br><br>Please respond to this email to confirm your appointment. If you should need to make any changes or adjustments, please give us a call at (Blank for online).<br><br>Please let me know if you have any questions.<br><br>Thank you!<br><br>Team<br>(206) 241-5033"
Const MACRO_NAME = "Send Meeting Reminder"
Const ERR_MSG = "You must select an appointment for this macro to work."
Dim olkApt As Object, _
olkRem As Outlook.MailItem, _
olkRec As Outlook.Recipient
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set olkApt = Application.ActiveExplorer.Selection(1)
Case "Inspector"
Set olkApt = Application.ActiveInspector.CurrentItem
End Select
If TypeName(olkApt) <> "Nothing" Then
If olkApt.Class = olAppointment Then
Set olkRem = Application.CreateItem(olMailItem)
With olkRem
.Subject = "Accounting and Tax Services - Appointment Reminder"
.HTMLBody = MSG_TEXT & .HTMLBody
.HTMLBody = Replace(.HTMLBody, "%START%", Format(olkApt.Start, "ddd, mmm d at h:mm AMPM"))
.HTMLBody = Replace(.HTMLBody, "%LOCATION%", olkApt.Location)
For Each olkRec In olkApt.Recipients
If (olkRec.Type <> olResource) And (olkRec.Name <> Session.CurrentUser.Name) Then
If Not olkRec.MeetingResponseStatus = olResponseDeclined Then
olkRem.Recipients.Add olkRec.Name
End If
End If
Next
.Recipients = "%LOCATION%"
If EDIT_FIRST Then
.Display
Else
.Send
End If
End With
Else
MsgBox ERR_MSG, vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox ERR_MSG, vbCritical + vbOKOnly, MACRO_NAME
End If
On Error GoTo 0
Set olkApt = Nothing
Set olkRem = Nothing
Set olkRec = Nothing
End Sub
I have been working away on a project and I am at a stopping point and would love help if anyone has insight on this. Here is the current Macro that I have. This will take an appointment and when ran will create an email to remind the client of their appointment including detail. Currently, it is successfully pulling/generating the email that I want to be sent.
The issue that I am having is that I want to have the email recipient field to pull from the appointment location field (we put the email address in the location field).
If any of you might be able to help or give me suggestions it would be greatly appreciated as I cannot figure it out.
Thank you!
Sub SendMeetingReminder()
'On the next line change True to False if you want the reminder to send without giving you the chance to edit it.
'Leave it set to True if you want an opportunity to edit the message before sending it.
Const EDIT_FIRST = True
'On the next line edit the message as desired. Both %START% and %LOCATION% are parameters that will be replaced
'with the meeting start time and location respectively before the message is displayed/sent.
Const MSG_TEXT = "Hello,<br><br>You have an upcoming appointment at Accounting and Tax Services.<br><br>Start: <b>%START%</b><br>Location: <b>(Blank for Online)
</b><br><br>Please respond to this email to confirm your appointment. If you should need to make any changes or adjustments, please give us a call at (Blank for online).<br><br>Please let me know if you have any questions.<br><br>Thank you!<br><br>Team<br>(206) 241-5033"
Const MACRO_NAME = "Send Meeting Reminder"
Const ERR_MSG = "You must select an appointment for this macro to work."
Dim olkApt As Object, _
olkRem As Outlook.MailItem, _
olkRec As Outlook.Recipient
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set olkApt = Application.ActiveExplorer.Selection(1)
Case "Inspector"
Set olkApt = Application.ActiveInspector.CurrentItem
End Select
If TypeName(olkApt) <> "Nothing" Then
If olkApt.Class = olAppointment Then
Set olkRem = Application.CreateItem(olMailItem)
With olkRem
.Subject = "Accounting and Tax Services - Appointment Reminder"
.HTMLBody = MSG_TEXT & .HTMLBody
.HTMLBody = Replace(.HTMLBody, "%START%", Format(olkApt.Start, "ddd, mmm d at h:mm AMPM"))
.HTMLBody = Replace(.HTMLBody, "%LOCATION%", olkApt.Location)
For Each olkRec In olkApt.Recipients
If (olkRec.Type <> olResource) And (olkRec.Name <> Session.CurrentUser.Name) Then
If Not olkRec.MeetingResponseStatus = olResponseDeclined Then
olkRem.Recipients.Add olkRec.Name
End If
End If
Next
.Recipients = "%LOCATION%"
If EDIT_FIRST Then
.Display
Else
.Send
End If
End With
Else
MsgBox ERR_MSG, vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox ERR_MSG, vbCritical + vbOKOnly, MACRO_NAME
End If
On Error GoTo 0
Set olkApt = Nothing
Set olkRem = Nothing
Set olkRec = Nothing
End Sub