Send Email

[allan.roebig]

Can someone please help!!

I'm trying to send an automatic email when 2 conditions are met.

In column X I have yes/no drop down box. If Column X has a "no" and the
date is 14 days older than dates that are in column B I want an email
automatically sent to the corresponding email address in Column G.There
are about 8 different email address.

I have the Send Mail code (below) from Ron deBruins site but I just
can't seem to get the worksheet code right.

Sub Mail()
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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strto = "(e-mail address removed)"
strcc = ""
strbcc = ""
strsub = "Important message"
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed"
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[GS]

Hi Allan,

This hasn't been tested because I don't use Outlook, but it should be close
to what you want. It handles the worksheet and passes the email address in
columnG to Mail() if the date in columnB is 14 days or older than the current
date.

Modify to suit...

'Put this in the code behind the worksheet
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Set rng = Intersect(Target, Range("X:X"))

If Not rng Is Nothing Then
If Target.Value = "No" And _
Cells(Target.Row, "B") <= (Date - 14) Then _
Mail Cells(Target.Row, "G")
End If

End Sub

'Modify as follows
Sub Mail(strto As String)
Dim OutApp As Object
Dim OutMail As Object
Dim strcc As String, strbcc As String
Dim strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strcc = ""
strbcc = ""
strsub = "Important message"
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed"
With OutMail
.To = strto
.cc = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Regards,
GS

 

[allan.roebig]

Thanks GS thats solved it, now if I could ask is it possible to
reference the info in an adjoining cell, say column B into the email
body.

Thanks once again

Al

 

[GS]

Hi Alan,

Yes, you could do that. As per your post, columnB already contains a date.
You just need to add another argument to Mail(), and create a variable to
hold the string value. I would change what I just gave you to include
variables for the values used.

If you are looking to construct a string value to pass to Mail() so it can
be used as a custom message, and contained in a cell in the same row, then
modify the code as follows:

'Modify as follows
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim dteOlderThan As String
Dim szMailTo As String, szCustomMsg As String

Set rng = Intersect(Target, Range("X:X"))
dteOlderThan = Cells(Target.Row, "B")
szMailTo = Cells(Target.Row, "G")
szCustomMsg = Cells(Target.Row, "B")

If Not rng Is Nothing Then
If Target.Value = "No" And _
dteOlderThan <= (Date - 14) Then _
Mail szMailTo, szCustomMsg
End If

End Sub

'Modify as follows
Sub Mail(szMailTo As String, szCustomMsg As String)
Dim OutApp As Object
Dim OutMail As Object
Dim strcc As String, strbcc As String
Dim strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strcc = ""
strbcc = ""
strsub = "Important message"
strbody = "Hi there" & vbNewLine & vbNewLine & _
szCustomMsg
With OutMail
.To = szMailTo
.cc = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

HTH
Regards,
GS

 

[allan.roebig]

Thanks again GS. Works great.

Regards

Al