Thanks:  0
Likes:  0

# Thread: Auto send email when dependant on date in cell

1. ## Auto send email when dependant on date in cell

I have a workbook that has compliance dates in columns "F","G" and "H" from row 7. What I need is when the date in either column comes within 30 days to auto send an email, address in column "A", recipients name in column "B". and then place todays date in column 'P". ALso need to send a follow up email when either date comes within 7days and then place todays date in column "Q". If there is a date in column "P" then don't send email. If there is a date in column "Q" then don't send follow up. Can this be done without the users intervention and each time the workbook is opened.
Thanks in advance for any assistance.

Mick

2. ## Re: Auto send email when dependant on date in cell

This may get you started http://www.rondebruin.nl/mail/change.htm

3. ## Re: Auto send email when dependant on date in cell

Thanks for the assist but I do not know enough about coding to adapt this to my requirements. Tried playing around with it and other code I managed to source but I just have to admit when I am beat. Not sure if you can give me more to work with.
Thanks
Mick

4. ## Re: Auto send email when dependant on date in cell

This is what I have so far. Macro is placing date in correct cell and sending the email. In column "A" I have the email addresses ("TO") and in column "B" I have the ("recipient"). I am not sure how to reference these cells in the email code. Hope you can help.

Mick

Sub Macro1()
Dim rngCell As Range
Dim rngMyDataSet As Range
Dim Rng As Range
Application.ScreenUpdating = False
'Assumes the due dates are in Column F. Change if required.
With ActiveSheet
If .FilterMode Then .ShowAllData

Set Rng = .Range("A7", .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each rngCell In Rng
If rngCell.Offset(0, 6) > 0 Then Exit Sub

If rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
rngCell.Offset(0, 6).Value = Date
Call Mail_small_Text_Outlook
End If

Next rngCell
Application.ScreenUpdating = True
End Sub

Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "According to our records your " & Range("F6").Value & " is due for renewal."

On Error Resume Next
With OutMail
.To = "testemail@test.com.au"
.CC = "testemail1@test2.com.au"
.BCC = ""
.Subject = "Request for Information"
.Body = strbody

.Display
End With
On Error GoTo 0
Set OutMail = Nothing

5. ## Re: Auto send email when dependant on date in cell

Hi,

You are using the code e.g rngCell.Offset(0, 5) already to check various values in the columns you should use this to get the email addresses too.

I think TO = rngCell.Value
and Recipient = rngCell.Offset(0, 1).Value

6. ## Re: Auto send email when dependant on date in cell

Thanks for the assist, not sure if this is the best way but I combined both macros into one and all appears to be working so far.
Still got some way to go, but so far it is doing what I want.
Thanks again I appreciate the help. I am sure there will be another stumbling block just around the corner. I would appreciate your feedback on the code I have so far.

Mick

Sub Macro1()
Dim rngCell As Range
Dim rngMyDataSet As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim EmailRecipient As String
Dim Signature As String
Application.ScreenUpdating = False
With ActiveSheet
If .FilterMode Then .ShowAllData
Set Rng = .Range("A7", .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each rngCell In Rng
If rngCell.Offset(0, 6) > 0 Then

ElseIf rngCell.Offset(0, 5) > Evaluate("Today() +7") And _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
rngCell.Offset(0, 6).Value = Date

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Dear " & rngCell.Offset(0, 1).Value & vbNewLine & "According to our records your " & Range("F6").Value & " is due for renewal on " & rngCell.Offset(0, 5).Value & vbNewLine & _
"Could you please ensure you send us a copy of your renewal prior to this date."
EmailSendTo = rngCell.Offset(0, 0).Value
EmailSubject = Sheets("sheet1").Range("F6").Value
EmailRecipient = rngCell.Offset(0, 1).Value
Signature = "C:\Documents and Settings\" & Environ("rmm") & _
"\Application Data\Microsoft\Signatures\rm.htm"
On Error Resume Next
With OutMail
.To = EmailSendTo
.BCC = ""
.Subject = EmailSubject
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End If

Next rngCell
Application.ScreenUpdating = True
End Sub

7. ## Re: Auto send email when dependant on date in cell

Hi Mick,

If the code works then don't worry about it. There are so many ways to skin a cat. I can't see anything that I wouldn't use. Maybe someone else might post a suggestion.

However you could place your code between code tags in your posts though. Looks neater and complies with the posting rules and is easier to read : )

http://www.mrexcel.com/forum/misc.php?do=bbcode#code
E.G
Code:

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Have a look at this post. It is a workbook open event that fires off a mail if a specific date is found. The Code is pasted in the 'ThisWorkbook' section of the VBA project rather than a module.

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•