Enrique A. Santos KM4ZQC
asked on
Automatic Email Reminder
Need email sent automatically when date is entered in any independent cell in column E3:E45.
Nestle-Water-B-Service-Master-Testi.xlsm
Option Explicit
Sub email()
Dim r As Range
Dim cell As Range
Set r = Range("E3:E45")
For Each cell In r
If cell.Value = Date Then
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = "Trucks Due for B Service"
Email_Send_From = ".com"
Email_Send_To = ".com"
Email_Cc = ""
Email_Bcc = ""
Email_Body = "body"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
End If
Next
Exit Sub
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
(Edit: Added CODE tags)Nestle-Water-B-Service-Master-Testi.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I apologize for attaching the wrong workbook to my previous Comment. I subsequently removed it to avoid confusion if somebody else should look at this thread.
Most likely, the failure of the code to run automatically is caused by putting the Worksheet_Change sub in the wrong location. Rightclick the sheet tab, and choose View code... from the resulting dialog. The resulting code pane is where the Worksheet_Change sub has to go.
I revised the email sub slightly because I noticed that Mail_Object hadn't been declared properly. I also updated the email addresses.
Most likely, the failure of the code to run automatically is caused by putting the Worksheet_Change sub in the wrong location. Rightclick the sheet tab, and choose View code... from the resulting dialog. The resulting code pane is where the Worksheet_Change sub has to go.
I revised the email sub slightly because I noticed that Mail_Object hadn't been declared properly. I also updated the email addresses.
Sub email(cell As Range)
Dim Email_Subject, Email_Send_From As String, Email_Send_To As String, Email_Cc As String, Email_Bcc As String, Email_Body As String
Static Mail_Object As Object
Dim Mail_Single As Object
If IsDate(cell.Value) Then
Email_Subject = "Trucks Due for B Service"
Email_Send_From = "enrique_delossanto@swifttrans.com"
Email_Send_To = "enrique_delossanto@swifttrans.com"
Email_Cc = ""
Email_Bcc = ""
Email_Body = "body"
On Error GoTo debugs
If Mail_Object Is Nothing Then Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
End If
debugs:
If Err <> 0 Then
If Err.Description <> "" Then MsgBox Err.Description
Err.Clear
End If
On Error GoTo 0
End Sub
Nestle-Water-B-Service-MasterQ28997.xlsm
ASKER
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Set targ = Range("E3:E45") 'Watch these cells for changes
Set targ = Intersect(targ, Target)
If Not targ Is Nothing Then
For Each cel In targ.Cells
If cel.Value <> "" Then email cel
Next
End If
End Sub
Sub email(cell As Range)
Dim Email_Subject, Email_Send_From As String, Email_Send_To As String, Email_Cc As String, Email_Bcc As String, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
If IsDate(cell.Value) Then
Email_Subject = "Trucks Due for B Service"
Email_Send_From = "enrique_delossanto@swiftt
Email_Send_To = "enrique_delossanto@swiftt
Email_Cc = ""
Email_Bcc = ""
Email_Body = "body"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Appl
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
End If
debugs:
If Err <> 0 Then
If Err.Description <> "" Then MsgBox Err.Description
Err.Clear
End If
On Error GoTo 0
End Sub