Outlook Recurring Email

abonnette86

New Member
Joined
Feb 21, 2020
Messages
10
Office Version
  1. 2013
Platform
  1. Windows
All,
I have been tasked with something that I am having trouble with. I need to create a VBA in Outlook that automatically sends an email every Friday @ 12PM - not a reminder to send an email, but a code that physically sends the email without any end user intervention.

1. It has to be sent if I'm logged in or not, or if Outlook is even open (AKA doesnt matter if I have that friday off or not, the email still gets sent)
2. The recipients are at separate locations, so I'd like each location to get it's own 'version' of the email using an excel file to control the info that goes out. (AKA the VBA triggers a separate email for each line. some locations I might want the body to say this not that, add/remove people, etc.). Rows in the excel file may be added or subtracted.

VBA Event triggers outgoing email for each line:LocationobjMsg.To =objMsg.CC =objMsg.BCC =objMsg.Subject =objMsg.Body =
Outgoing Email 1Place 1
Outgoing Email 2Place 2
Outgoing Email 3Place 3
3. I would like the option to attach a different excel file saved to my desktop.

So far this is what I have. It worked by creating a new category and assigning a new appointment to that category, and setting the desired recurrence. I realize the code I have is no where near where it needs to be to achieve what I want, but thats why I need help.

Private Sub Application_Reminder(ByVal Item As Object)
Dim objMsg As MailItem
Dim objApp As AppointmentItem
Dim Att As Attachment
Dim tmpFolder As String
Dim filePath As String
Set objMsg = Application.CreateItem(olMailItem)

If Item.MessageClass <> "IPM.Appointment" Then
Exit Sub
End If

If Item.Categories <> "Recurring Email" Then
Exit Sub
End If

tmpFolder = Environ("TEMP")

For Each Att In Item.Attachments
filePath = tmpFolder & "\" & Att.Filename
Att.SaveAsFile (filePath)
objMsg.Attachments.Add filePath
Kill filePath
Next Att

objMsg.To = Item.Location
objMsg.Subject = Item.Subject
objMsg.Body = Item.Body
objMsg.Send
Set objMsg = Nothing
End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top