Automatically Send Emails

%3CLINGO-SUB%20id%3D%22lingo-sub-3031892%22%20slang%3D%22en-US%22%3EAutomatically%20Send%20Emails%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3031892%22%20slang%3D%22en-US%22%3E%3CP%3EHello%2C%3C%2FP%3E%3CP%3EI've%20found%20a%20script%20that%20sends%20emails%20automatically%20and%20it%20seems%20to%20work%20well.%3C%2FP%3E%3CP%3EThe%20problem%20is%20I%20have%20to%20send%20more%20than%20one%20automated%20email%20a%20week%20-%20and%20at%20different%20times.%3C%2FP%3E%3CP%3EIs%20there%20a%20way%20to%20manipulate%20or%20modify%20this%20code%20(or%20use%20a%20different%20one%20that%20is)%20so%20that%20I%20can%20sent%20multiple%20emails%20a%20week%20at%20different%20times%3F%3C%2FP%3E%3CP%3EThanks%20in%20advance!%3CBR%20%2F%3EWayne.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPrivate%20Sub%20Application_Reminder(ByVal%20Item%20As%20Object)%3C%2FP%3E%3CP%3EDim%20objMsg%20As%20MailItem%3CBR%20%2F%3EDim%20objApp%20As%20AppointmentItem%3CBR%20%2F%3EDim%20Att%20As%20Attachment%3CBR%20%2F%3EDim%20tmpFolder%20As%20String%3CBR%20%2F%3EDim%20filePath%20As%20String%3CBR%20%2F%3ESet%20objMsg%20%3D%20Application.CreateItem(olMailItem)%3C%2FP%3E%3CP%3EMsgBox%20%22Appointment%20Triggered%22%3C%2FP%3E%3CP%3E'message%20is%20appointment%3CBR%20%2F%3EIf%20Item.MessageClass%20%26lt%3B%26gt%3B%20%22IPM.Appointment%22%20Then%20Exit%20Sub%3CBR%20%2F%3E'The%20appointment%20is%20set%20as%20%22Send%20Schedule%20Recurring%20Email%22%20Category%3CBR%20%2F%3EIf%20Item.Categories%20%26lt%3B%26gt%3B%20%22Send%20Schedule%20Recurring%20Email%22%20Then%20Exit%20Sub%3C%2FP%3E%3CP%3E'MsgBox%20Item.MessageClass%3CBR%20%2F%3E'MsgBox%20Item.Categories%3CBR%20%2F%3E'MsgBox%20Item.Location%3CBR%20%2F%3E'MsgBox%20Item.Subject%3CBR%20%2F%3E'MsgBox%20objMsg.Body%3CBR%20%2F%3E'MsgBox%20Environ(%22USERPROFILE%22)%3C%2FP%3E%3CP%3E'to%20get%20the%20path%20of%20the%20email%20attachment%3CBR%20%2F%3EtmpFolder%20%3D%20Environ(%22USERPROFILE%22)%3C%2FP%3E%3CP%3E'Add%20each%20attachment%20to%20email%20object%20to%20be%20sent%3CBR%20%2F%3EFor%20Each%20Att%20In%20Item.Attachments%3CBR%20%2F%3EfilePath%20%3D%20tmpFolder%20%26amp%3B%20%22%5C%22%20%26amp%3B%20Att.FileName%3CBR%20%2F%3EAtt.SaveAsFile%20(filePath)%3CBR%20%2F%3EobjMsg.Attachments.Add%20filePath%3CBR%20%2F%3EKill%20filePath%3CBR%20%2F%3ENext%20Att%3C%2FP%3E%3CP%3E'send%20email%20object%3CBR%20%2F%3EobjMsg.To%20%3D%20Item.Location%3CBR%20%2F%3EobjMsg.Subject%20%3D%20Item.Subject%3CBR%20%2F%3EobjMsg.Body%20%3D%20Item.Body%3CBR%20%2F%3EobjMsg.Send%3CBR%20%2F%3ESet%20objMsg%20%3D%20Nothing%3C%2FP%3E%3CP%3EEnd%20Sub%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-3031892%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EOffice%20365%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EOffice%20Apps%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Occasional Contributor

Hello,

I've found a script that sends emails automatically and it seems to work well.

The problem is I have to send more than one automated email a week - and at different times.

Is there a way to manipulate or modify this code (or use a different one that is) so that I can sent multiple emails a week at different times?

Thanks in advance!
Wayne.

 

 

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)

MsgBox "Appointment Triggered"

'message is appointment
If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
'The appointment is set as "Send Schedule Recurring Email" Category
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub

'MsgBox Item.MessageClass
'MsgBox Item.Categories
'MsgBox Item.Location
'MsgBox Item.Subject
'MsgBox objMsg.Body
'MsgBox Environ("USERPROFILE")

'to get the path of the email attachment
tmpFolder = Environ("USERPROFILE")

'Add each attachment to email object to be sent
For Each Att In Item.Attachments
filePath = tmpFolder & "\" & Att.FileName
Att.SaveAsFile (filePath)
objMsg.Attachments.Add filePath
Kill filePath
Next Att

'send email object
objMsg.To = Item.Location
objMsg.Subject = Item.Subject
objMsg.Body = Item.Body
objMsg.Send
Set objMsg = Nothing

End Sub

0 Replies