Outlook VBA - recurring task to send email

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
2,004
Office Version
  1. 365
Platform
  1. Windows
hi folks,

I have found a great way to send out reminders to submit work to a group of people based on a recurring task.

https://www.datanumen.com/blogs/auto-send-recurring-email-periodically-outlook-vba/

in ThisOutlookSession, you paste the following code:

Code:
Private Sub Application_Reminder(ByVal Item As Object)
    Dim objPeriodicalMail As MailItem
 
    If Item.Class = olTask Then
       If InStr(LCase(Item.Subject), "send an email periodically") Then
          Set objPeriodicalMail = Outlook.Application.CreateItem(olMailItem)
          'Change the following email information as per your actual needs
          With objPeriodicalMail
               .Subject = "Test"
               .To = "boss@datanumen.com"
               .HTMLBody = "<HTML>******>type body here</HTML></BODY>"
               .Attachments.Add ("C:\Attachments\DataNumen.docx")
               .Importance = olImportanceHigh
               .ReadReceiptRequested = True
               .Send
          End With
       End If
    End If
End Sub

In attempting to add email signature and line breaks, i adjusted it by including parts of Ron Debruin's work from

https://www.rondebruin.nl/win/s1/outlook/signature.htm

Example 2 : Insert the signature that you want without picture

Code:
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Customer Ron de Bruin" & _
              "Please visit this website to download the new version." & _
              "Let me know if you have problems." & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "Thank you"

    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next

    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        .Send    'or use .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

I have ended up with:

Code:
Private Sub Application_Reminder(ByVal Item As Object)
    Dim objPeriodicalMail As MailItem
    Dim strbody As String, strSubject As String
    Dim SigString As String
    Dim Signature As String
 
    If Item.Class = olTask Then
       If InStr(LCase(Item.Subject), "Reminder: Radiology partnership distribution changes") Then
          Set objPeriodicalMail = Outlook.Application.CreateItem(olMailItem)
          
          strbody = "Good morning doctors.<br><br>" & _
              "Please provide any distribution changes for end of month processing by <I><u>the end of next week</u></I>.<br><br>" & _
              "Let me know if you have problems." & _
              "<br><br>Thank you"
              
          strSubject = "Reminder: Radiology partnership distribution changes"
              
    'Change only Mysig.htm to the name of your signature
   ' SigString = Environ("appdata") & _
                "\Microsoft\Signatures\sig.htm"

    'If Dir(SigString) <> "" Then
       ' Signature = GetBoiler(SigString)
    'Else
        'Signature = ""
    'End If

    On Error Resume Next

    With objPeriodicalMail
    'Change the following email addresses as needed
        .SentOnBehalfOfName = "me@work"
        .Subject = "Reminder: Radiology partnership distribution changes"
        .To = "me2@work"
        .CC = ""
        .BCC = ""
        .Subject = strSubject
        .HTMLBody = strbody & "<br>" & Signature
        .Importance = olImportanceHigh
        .ReadReceiptRequested = True
        .Send    'or use .Display
    End With

    On Error GoTo 0
          
          
          
       End If
    End If
End Sub


'Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
   ' Dim fso As Object
   ' Dim ts As Object
    'Set fso = CreateObject("Scripting.FileSystemObject")
    'Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    'GetBoiler = ts.readall
   ' ts.Close
'End Function

I have commented out the signature parts while trying to work out why it doesn't work. Ron's macro is entered into a standard module while the Datanum work is meant for the ThisOutlookSession” project.

I am using Excel 2016
 
Last edited:

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
this worked:

Code:
Private Sub Application_Reminder(ByVal Item As Object)
    Dim objPeriodicalMail As MailItem
    Dim strbody As String, strSubject As String
    Dim SigString As String
    Dim Signature As String
 
    If Item.Class = olTask Then
       If InStr(LCase(Item.Subject), "reminder: radiology partnership distribution changes") Then
          Set objPeriodicalMail = Outlook.Application.CreateItem(olMailItem)
          
          strbody = "Good morning doctors.<br><br>" & _
              "Please provide any distribution changes for end of month processing by <I><u>the end of next week</u></I>.<br><br>" & _
              "Let me know if you have problems." & _
              "<br><br>Thank you"
              
          strSubject = "Reminder: Radiology partnership distribution changes"
              
    'Change only Mysig.htm to the name of your signature
   SigString = Environ("appdata") & _
                "\Microsoft\Signatures\sig.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next

    With objPeriodicalMail
    'Change the following email addresses as needed
        .SentOnBehalfOfName = "email@whereiwork.com.au"
        .Subject = "Reminder: Radiology partnership distribution changes"
        .To = "bloke1@whereiwork.com.au; bloke2@whereiwork.com.au"
        .CC = "bloke3@whereiwork.com.au"
        .BCC = ""
        .Subject = strSubject
        .HTMLBody = strbody & "<br>" & Signature
        .Importance = olImportanceHigh
        .ReadReceiptRequested = True
        .Send    'or use .Display
    End With

    On Error GoTo 0
          
          
          
       End If
    End If
End Sub


Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
   ts.Close
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,104
Members
448,548
Latest member
harryls

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