VBA/Macros to send outlook email notification from excel

KatieB1981

New Member
Joined
Dec 9, 2020
Messages
1
Office Version
  1. 2019
Platform
  1. Windows
Hi All,
I have created a spreadsheet in excel to record our staff tickets and qualification along with their expiry date. I have applied conditional formatting (colour code system) so that each cell changes colour when it is within 60 days of expiry. See attached as an example of the conditional formatting.
The question has now been asked whether VBA/Macros can be added to send out email notifications when qualifications are due to expire.
The message can be simple: "(NAME), (QUALIFICATION), is due to expire within 60 days. Please renew accordingly"
Can this be done? I am new to VBA - so any assistance and coding would be appreciated.
 

Attachments

  • Example.JPG
    Example.JPG
    36.3 KB · Views: 19

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

severynm

Board Regular
Joined
Jan 8, 2021
Messages
56
Office Version
  1. 365
Platform
  1. Windows
What you are asking for is very possible and relatively simple. Add this to a new module. Also, follow the instructions at the bottom of the page here to add the needed Outlook references to the VBA editor.
VBA Code:
Option Explicit

Public Sub CreateEmail()
    Dim idx As Integer
    Dim count As Integer
    Dim dateRange As Range
    Dim emailRange As Range
    
    Set dateRange = Sheet1.Range("A1:A10") 'Customize with your sheet name and range
    Set emailRange = Sheet1.Range("B1:B10") 'Customize with your sheet name and range
    count = dateRange.count 'Number of cells in the range
    
    'Create email object & populate necessary fields
    Dim OutApp As New Outlook.Application
    Dim OutMail As Outlook.MailItem
    Set OutMail = OutApp.CreateItem(olMailItem)
    
    For idx = 1 To count 'Loop through all rows in the range
        If dateRange.Rows(idx).Value < Now() - 60 Then 'If the date is older than (today - 60d)
            On Error Resume Next
            With OutMail
                .To = emailRange.Rows(idx).Value
                .Subject = "..." 'customize as necessary
                .Body = "..." 'customize as necessary
                .Display '.Send 'Swap out as needed
            End With
            On Error GoTo 0
        End If

    Next idx
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

You will need to run it manually yourself, but if you like, you can link this to a button to make running the code easier. If you want the VBA to run without any user intervention at all, you can always call the function from the workbook Open, BeforeSave, or BeforeClose, depending on your intent.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,611
Messages
5,625,829
Members
416,138
Latest member
Pizzaman22

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
Top