Email to notify expiry date

[Glimmer]

Hello

I am looking for help on solving this, I am looking for a way to be able to send an email notification 30 days before the contract expires.
I have attached a sample list. Is there anyway of doing this using a macro or through VBA?

thank you !

[Paul]

Hi Glimmer, well here's a shot at it...

I borrowed some code to send e-mail from Microsoft Outlook from Ron deBruin's site (http://www.rondebruin.nl/sendmail.htm). Please see attached spreadsheet.

I added a command button to your worksheet (although that's optional, you could just as easily use a key combination or run it manually). The code to check each cell in column B for the expiry date, as well as the e-mail code, is shown below. Let us know if you need further assistance.

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String

    For i = 4 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Cells(i, 2).Value <= (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            With Sheets("Sheet1")
                strto = .Cells(i, 3).Value
                strcc = .Cells(i, 4).Value
                strbcc = ""
                strsub = "Contract Expiry Notice"
                strbody = "Hi there" & vbNewLine & vbNewLine & _
                    "Your contract, " & .Cells(i, 1).Value & _
                    ", is due to expire on " & .Cells(i, 2).Value & _
                    ". Please contact us at your earliest convenience." & _
                    vbCrLf & vbCrLf & "Thank you."
            End With
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub

[krajivgandhi]

paul...did a great job...this is what i was searching for days...gr8 job..really nice attachment..how to move that send mail button to some corner..

[Glimmer]

Hello Paul

Thank you. Just what I was looking for.
just a slight issue- it sends out an email every time i click the send mail button to even the ones below 30days. is it possible to send it wen the date difference is exactly 30days?
Also is there a way it would send out the mail without opening the worksheet ?

thank you so much !

[Paul]

Hi G,

To send it to those where the difference is exactly 30 days, change

If Cells(i, 2).Value <= (Date + 30) Then

to

If Cells(i, 2).Value = (Date + 30) Then

I don't see how you could run an Excel macro without Excel being open. You could schedule a task in Windows to open the Excel file at a certain time of day, and then in the Excel workbook apply the previous code to the Workbook_Open event, though.

[Glimmer]

Hello Paul

thank you. Scheduling a task in windows sounds good. I didnt quite understand the workbook_openevent bit. Does that mean once I have added the macro to the excel sheet and set up the task in windows to open the file daily it will automatically email out ?

thanks

[Paul]

To insert this code into the Workbook_Open event:

1. Copy all of the code shown below. I adjusted it slightly to always reference the sheet named "Sheet1". If your sheet name is different, change any references to Sheet1 to your sheet name.
2. Open the VBA Editor in your workbook (ALT+F11).
3. Double-click the "ThisWorkbook" entry in the left-hand column (the one beneath 'VBAProject (your_workbook_name_here)'.
4. Paste the code below into the right-hand pane.
5. Save and close the workbook.
6. The next time you open the workbook (either manually or via Task Scheduler), the code should run immediately (as long as your macro security is set to low). You may want to put in a test row to make sure it runs.

Private Sub Workbook_Open()
Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String

    For i = 4 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Sheets("Sheet1").Cells(i, 2).Value = (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            strto = Sheets("Sheet1").Cells(i, 3).Value
            strcc = Sheets("Sheet1").Cells(i, 4).Value
            strbcc = ""
            strsub = "Contract Expiry Notice"
            strbody = "Hi there" & vbNewLine & vbNewLine & _
                "Your contract, " & Sheets("Sheet1").Cells(i, 1).Value & _
                ", is due to expire on " & Sheets("Sheet1").Cells(i, 2).Value & _
                ". Please contact us at your earliest convenience." & _
                vbCrLf & vbCrLf & "Thank you."
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub

Hopefully that works for you.

[Glimmer]

thank you paul for such a detailed and step by step solution. that was very helpful.

[Paul]

My pleasure, glad to help out.

[Glimmer]

Hello Paul

I have tested it out and it works very well. thank you once again ! If I wanted to add another email address in col E to be notified where would I have to make a change in the code ? I tried few things but it didnt really work.

thank you

[Paul]

You should be able to make the following change (see code in red):

Private Sub Workbook_Open()
Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String

    For i = 4 To Sheets("Sheet1").Range("B65536").End(xlUp).Row
        If Sheets("Sheet1").Cells(i, 2).Value = (Date + 30) Then
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
        
            strto = Sheets("Sheet1").Cells(i, 3).Value
            strcc = Sheets("Sheet1").Cells(i, 4).Value & _
                        "; " & Sheets("Sheet1").Cells(i, 5).Value
            strbcc = ""
            strsub = "Contract Expiry Notice"
            strbody = "Hi there" & vbNewLine & vbNewLine & _
                "Your contract, " & Sheets("Sheet1").Cells(i, 1).Value & _
                ", is due to expire on " & Sheets("Sheet1").Cells(i, 2).Value & _
                ". Please contact us at your earliest convenience." & _
                vbCrLf & vbCrLf & "Thank you."
    
            With OutMail
                .To = strto
                .CC = strcc
                .BCC = strbcc
                .Subject = strsub
                .Body = strbody
                .Send
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next i
End Sub

Semi-colons are typically valid as e-mail address separators, however if your default is something else (a comma, for example), change the semi-colon to that character.

[Glimmer]

Hello Paula

thank you so much

[Paul]

Hello Paula

I suppose I've been called worse.

Glad I could help out again.

[Glimmer]

oops Paul, sorry that was a typo !

[Ignorant]

Hi Paul,

This code worked great for me.Thanks a lot!!
Though I have modified it a bit and wish to modify a little more.

Could you suggest on following:
1. Can this code be made to work - without starting the outlook in background? - as I see this code should work without starting the outlook - but it doesn't seem to work for me.
2. If I wish to use my SMTP mail server , is there any provision in the VBA to code for SMTP send mail - like we do in code?
3. If I wish to consolidate some data - based on that expiry date criteria and then put into an Excel sheet and then mail the sheet itself as a report - would it be possible? I guess - Yes but I don't knwo how to do it.

Many Thanks
Naveen

[kumar_shri]

Hi Paul,

This code worked great for only one cell not for all expired cell. i want auto email genrate all expired contract nos after open the sheet. hear attached my sheet, so please help me for solve this problem,

thanks and regards,
Shri.

[lohnro]

Hi Paul, Thank you for the code it is working for me I am having problem with date format , (excel 2010) Day, Month Year, it will send with 2/11/2012 or 1/04/2012 or 10/03/2012, but will need send 26/02/2012 do you have any ideas,

Thankyou
Kind Regards
Darrel

[Paul]

Please take a moment to read the forum rules and then start a new thread. If another member's thread is relevant to your own question, post a link to it in your new thread.

(Also, try searching the forum for the VBA "Format" command.)