Auto populate e-mails

[ManojD]

Hi,
I am new to this, don't know whether already my question is being answered. Still if someone can help with this, really appreciate. I have a worksheet with expiry dates of licences for several courses for few employees.
<TABLE style="WIDTH: 360pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=478><COLGROUP><COL style="WIDTH: 100pt; mso-width-source: userset; mso-width-alt: 4864" width=133><COL style="WIDTH: 69pt; mso-width-source: userset; mso-width-alt: 3364" width=92><COL style="WIDTH: 65pt; mso-width-source: userset; mso-width-alt: 3145" span=2 width=86><COL style="WIDTH: 61pt; mso-width-source: userset; mso-width-alt: 2962" width=81><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 100pt; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20 width=133>Employee Name</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 69pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 width=92>Licence A</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 65pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 width=86>Licence B</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 65pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 width=86>Licence C</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 61pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl66 width=81>Licence D</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Employee 1</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Mar</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Apr</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-May</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Mar</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Employee 2</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>02-Mar</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>02-May</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Mar</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Jun</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Employee 3</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>01-Mar</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>15-Feb</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>02-Mar</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl65 align=right>03-Mar</TD></TR></TBODY></TABLE>

I want to generate an email 15 days prior to expiry to inform the HR to arrange a renewal. Email should be worded as follows,

"Employee 1" "Licence A" expires on "Date"
"Employee 2" "Licence A" expires on "Date"

I guess it's not that hard to code, I am new to VBA so please help me. I learnt many things from here and this is the greatest site I found for excel. Thanks guys, keep up your good work.
Thanks,
Manoj

 

[Derek Brown]

Hello and welcome to The Board.
Have a look at my reply in post:
http://www.mrexcel.com/forum/showthread.php?t=409153&highlight=email

You would need to set the variable "strReportBody" to take the values from the workbook.

 

[ManojD]

Thanks for your reply. Yes, I looked at that and doesn't know how to take the information from the worksheet to the body of the text. Appreciate if you could help me on that. Thanks

 

[BrianExcel]

Check out Ron deBruin's site. he has a bunch of different methods you can use to do email from Excel.

http://www.rondebruin.nl/sendmail.htm

 

[daverunt]

Hi,

here's some code for you to play with.

It assumes the ActiveSheet has all the details on.

It uses the Workbook open event to trigger any mails due on the day (15 days before the cell date.

I'm hoping I got the date code right!

You need to add an email address or the cells where the addresses are stored can be extracted like the subject/date.

The mails will currently only display until you uncomment out the 'Send

Paste the code in the ThisWorkbook of the project for it to run when the workbook opens.

If you want to mess around stick it in a module and change the

Private Sub Workbook_Open()

to Sub mail_test() or something.

and run it as a normal macro.

Private Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim c As Long
Dim r As Long
 
    Sheets("Sheet1").Activate
 
Set rng = Range("B2:E100")
 
For Each cell In rng
 
'Gen a reference for the row/column numbers
 Num = cell.Row
 clm = cell.Column
 
'Work out date
       Dte = Cells(Num, clm).Value
    MailDte = DateAdd("d", -15, Dte)
If Date = MailDte Then
 
'Subject string
    EmailSubject = Cells(1, clm).Value & " Expiry Notice"
 
    [COLOR=red]EmailSendTo = "?"[/COLOR]
 
 
[COLOR=red]'generate Mail Body[/COLOR]
    MailBody = Cells(Num, 1).Value & " " & Cells(1, clm).Value _
    & " Expires on " & Cells(Num, clm).Value
 
 [COLOR=red]MsgBox (MailBody) ' remove[/COLOR]
 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .Body = MailBody
            [COLOR=red].Display[/COLOR]
[COLOR=red]         '.send[/COLOR]
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
        'MailBody = ""
 
    End If
Next
End Sub

 

[daverunt]

The above code relies on the file being opened every day to check whether the expiry email should be sent.

Probably a bit late but here's some code that works if the generated mail is 15 days or less. That might occur for example after a weekend of not opening the file.
A check of 15 days or less would cause a mail to be sent for every day less than 15 for the same cell each time the file is opened.

To get around this when a mail is sent for any cell of 15 days or less the cell colour is also changed to yellow. This is checked alongside the date and prevents a repeat mail being sent. The workbook is saved at the end of the macro because of this.

Private Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim c As Long
Dim r As Long
 
    Sheets("Sheet1").Activate
 
Set rng = Range("B2:E100")
 
For Each cell In rng
If cell.Value <> "" Then
Num = cell.Row
clm = cell.Column
'Work out date
    cell.Activate
    Dte = Cells(Num, clm).Value
 
   MailDte = DateAdd("d", -15, Dte)
    If Date >= MailDte And ActiveCell.Interior.ColorIndex = xlNone Then
        mail = True
    If mail = True Then
        ActiveCell.Interior.ColorIndex = 36
    End If
'Subject string
    EmailSubject = Cells(1, clm).Value & "Expiry Notice"
    EmailSendTo = "?"
    MailBody = Cells(Num, 1).Value & " " & Cells(1, clm).Value _
    & " Expires on " & Cells(Num, clm).Value
 
 MsgBox (MailBody) 'remove
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .Body = MailBody
            .Display
            '.send
        End With
 
        Set OutMail = Nothing
        Set OutApp = Nothing
        'MailBody = ""
 End If
    End If
Next
 
ThisWorkbook.Close SaveChanges:=True
End Sub

 

[ManojD]

Thanks both works great, thank you so much guys