Command button to send/display email to corresponding email address if condition is met

rimilam

New Member
Joined
Aug 7, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello VBA experts,

I have a spreadsheet that I would like to add a command button to that would populate an email to the corresponding email address, but only if a condition is met (an upcoming due date). I have tried several versions of code, but none have worked so far and I'm also a beginner VBA user so I haven't been able to try anything too complicated.

Here is how my spreadsheet is set up: I have a due date in Column G and a drop down list of names in Column I, which populates the email address for that person into Column L. What I want to do is add a command button which, when clicked, will display an email to the person's email address in Column L, but only if the due date in Column G is coming up within the week, or is past due. I need the macro to check each row for the due date and email address, then move on to the next row. I did try creating a "helper" Column J that says "email" if the due date is <=TODAY() +7, but it's just not working. I don't know if it's worth noting, but there are three worksheets in my workbook, but this button and macro only needs to apply to one.

I tried using the follow code which I found on Ron de Bruin's excel automation site, but it isn't working, or giving me any errors, so I'm not sure where the problem is. Any help would be greatly appreciated. I hope that all makes sense.

Sub DisplayEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("L").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "J").Value) = "email" Then

Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Action Item Due"
.Body = "Hi there, " & vbNewLine & vbNewLine & _
"You have an action item with an upcoming due date."
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Hi and welcome to MrExcel.

Put here a sample of your data, change confidential information for generic data.
Use the XL2BB tool to put a range of cells here (see my signature).
In the rows of your data range indicate which, based on your condition, are the records that should be sent by mail.
 

rimilam

New Member
Joined
Aug 7, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Here is my spreadsheet. I created columns J-M to work as "helper" columns which will be hidden once I get the macro working. The individuals listed in Column I should get an email to address in Column M if the text in Column K =email. Those individuals have a due date that is upcoming or past due, as indicated by the red highlighted cells. I want all emails to display upon clicking on a command button.

Copy of Long Screw Meeting Tracker.xlsm
ABCDEFGHIJKLMN
1Project:    REVISION BOX
2Long Screws    6/17/2020
3    1
4PREPARED BY: QuintenPhone: Insert Phone    
5Issue / Item (What)    
6TaskSubtaskDescription:Recommended ActionsOpen DatePromise /Revised DateActual Completion DateChampion    Comments
7Marketing/Sales    
8Surgical Technique Release26-Jun-20Justinemailemailjustin.hyer@osteocentric.comjustin.hyer@osteocentric.com
9    
10    
11Manufacturing    
126Parts through final inspection    
131#110040 2.5mm Drill bit, PO 6263-Jun-2014-Aug-20Robinemailemailrobin.wheelwright@osteocentric.comrobin.wheelwright@osteocentric.com5-13, Inspection, AO Flat defect, Andy, to speak with Eric to give approval on instruments with cosmetic defect 5-20, Eric approved, but need to work with supplier on improving, create an NCMR. 6-3, Update from Lydia on timeline, FAI being re-done, to inspect for Cal Lines. 6-10, In MRB,Choose to Scrap? Confirm with Andy. Amy to contact Eva-Lution on drill production, Q to look into off-the shelf parts. TR-NCMR-064-20 6-17, Working with PI, updating prints on both sides for release, Waiting on Validation Lab Report. 6-23, Rev C Scraped, Waiting for Rev D parts to arrive
1412Fastener Sleeve (110701) -Re-order new tolerance option17-Jun-202-Oct-20Justin  justin.hyer@osteocentric.comjustin.hyer@osteocentric.com6-17, None on order, get with Rosa. 6-24, Managing inventory?? Todd, Deepa, Amy, Linda to discuss at MRB today.
159-Aug-20Thomasemailemailthomas.perry@osteocentric.comthomas.perry@osteocentric.com
Open issues
Cell Formulas
RangeFormula
J1:J15J1=IF(G1="","",IF(G1<=(TODAY()+7),"email",""))
K1:K15,M1:M15K1=J1
L1:L15L1=IF(I1="Robin","robin.wheelwright@osteocentric.com",IF(I1="Justin","justin.hyer@osteocentric.com",IF(I1="Thomas","thomas.perry@osteocentric.com","")))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
G1:G43Expression=$K1="email"textNO
Cells with Data Validation
CellAllowCriteria
I8:I10ListRobin,Justin,Thomas
I12:I15ListRobin,Justin,Thomas
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Try this. I considered column J to go through the cells since it is where the criteria will be checked.

VBA Code:
Sub DisplayEmail()
  Dim OutMail As Object
  Dim cell As Range
  
  Application.ScreenUpdating = False
  
  For Each cell In Range("J7", Range("J" & Rows.Count).End(3))
    If cell.Value = "email" And Cells(cell.Row, "L") Like "?*@?*.?*" Then
    
      On Error Resume Next
        Set OutMail = CreateObject("Outlook.Application").CreateItem(0)
        With OutMail
          .To = Cells(cell.Row, "L").Value
          .Subject = "Action Item Due"
          .Body = "Hi there, " & vbNewLine & vbNewLine & _
              "You have an action item with an upcoming due date."
          .Display 'Or use .Send to send
        End With
      On Error GoTo 0
    
    End If
  Next cell
  
  Set OutMail = Nothing
  Application.ScreenUpdating = True
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,111
Messages
5,546,000
Members
410,720
Latest member
SSL
Top