PDA

View Full Version : Sending e-mails through separate reminders



Xandler
08-08-2017, 10:46 AM
Totally new to using VBA but through searching through various search engines (mainly Google) I managed to come up with code to send an automated e-mail through a pop-up reminder (and subsequently dismiss it). What I'm hoping to be able to do is send different automated e-mails through different reminders but don't quite know how to set it up (where to put the code to send the different e-mail). My current code looks like so:


Private Sub Application_Reminder(ByVal Item As Object)
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
Dim outapp As Object
Dim outmsg As Object
Set olRemind = Outlook.Reminders

Set outapp = CreateObject("outlook.application")
Set outmsg = outapp.CreateItem(0)

If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
If Item.Categories <> "Send Schedule Recurring Email" Then Exit Sub

Set wd = CreateObject("Word.Application")
Set doc = wd.Documents.Open(FileName:="C:\MyFile.docx")
doc.Content.Copy
doc.Close
Set wd = Nothing

Set oMail = Application.CreateItem(olMailItem)
With oMail
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
.To = Item.Location
.Subject = Item.Subject
.Send
End With
End Sub
Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)

For Each objRem In olRemind
If objRem.Caption = Item.Subject Then
If objRem.IsVisible Then
objRem.Dismiss
Cancel = True
End If
Exit For
End If
Next objRem

End Sub


Any help is appreciated!

Xandler

skatonni
11-22-2017, 01:16 PM
On possibility would be to differentiate by Subject.


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

Select Case Item.Subject

Case "Reminder One"

Debug.Print "Reminder one"

'Set wd = CreateObject("Word.Application")
'Set doc = wd.Documents.Open(filename:="C:\MyFile.docx")
'doc.Content.Copy
'doc.Close
'Set wd = Nothing

Case "Reminder Two"

Debug.Print "Reminder two"

'Set wd = CreateObject("Word.Application")
'Set doc = wd.Documents.Open(filename:="C:\MySecondFile.docx")
'doc.Content.Copy
' doc.Close
'Set wd = Nothing

End Select