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:
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
I have ended up with:
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
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 SubIn 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 FunctionI 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 FunctionI 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:
