SnailTerminator
New Member
- Joined
- Jan 24, 2021
- Messages
- 7
- Office Version
- 2013
- Platform
- Windows
Hi all.
Wonder if anyone could advise.
I have this spreadsheet that I am trying to automate so it sends an email containing the rows that meet the criteria of today's date. I do have a basic code, but unfortunately I have two problems.
1) I can only seem to add one cell from the selected row (but I need all the relevant information from columns B-G).
2) If multiple rows meet the current date it generates multiple emails (I just need the one email but with the multiple rows below each other).
I am new to VBA and coding in general so any help would be greatly appreciated.
Here's the code and see below a picture of the sheet.
Private Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
' Change the following as needed
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "Due date reached"
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For lRow = 2 To lLastRow
If Cells(lRow, 11) = "S" Then
If Cells(lRow, 1) = Date Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = sSendTo
If sSendCC > "" Then .CC = sSendCC
If sSendBCC > "" Then .BCC = sSendBCC
.Subject = sSubject
sTemp = "Hello!" & vbCrLf & vbCrLf
sTemp = sTemp & "The due date has been reached "
sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
' Assumes project name is in column B
sTemp = sTemp & " " & Cells(lRow, 2)
sTemp = sTemp & "Please take the appropriate"
sTemp = sTemp & "action." & vbCrLf & vbCrLf
sTemp = sTemp & "Thank you!" & vbCrLf
.Body = sTemp
' Change the following to .Send if you want to
' send the message without reviewing first
.Display
End With
Set OutMail = Nothing
Cells(lRow, 11) = "S"
Cells(lRow, 12) = "E-mail sent on: " & Now()
End If
End If
Next lRow
Set OutApp = Nothing
End Sub
Wonder if anyone could advise.
I have this spreadsheet that I am trying to automate so it sends an email containing the rows that meet the criteria of today's date. I do have a basic code, but unfortunately I have two problems.
1) I can only seem to add one cell from the selected row (but I need all the relevant information from columns B-G).
2) If multiple rows meet the current date it generates multiple emails (I just need the one email but with the multiple rows below each other).
I am new to VBA and coding in general so any help would be greatly appreciated.
Here's the code and see below a picture of the sheet.
Private Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
' Change the following as needed
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "Due date reached"
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For lRow = 2 To lLastRow
If Cells(lRow, 11) = "S" Then
If Cells(lRow, 1) = Date Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = sSendTo
If sSendCC > "" Then .CC = sSendCC
If sSendBCC > "" Then .BCC = sSendBCC
.Subject = sSubject
sTemp = "Hello!" & vbCrLf & vbCrLf
sTemp = sTemp & "The due date has been reached "
sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
' Assumes project name is in column B
sTemp = sTemp & " " & Cells(lRow, 2)
sTemp = sTemp & "Please take the appropriate"
sTemp = sTemp & "action." & vbCrLf & vbCrLf
sTemp = sTemp & "Thank you!" & vbCrLf
.Body = sTemp
' Change the following to .Send if you want to
' send the message without reviewing first
.Display
End With
Set OutMail = Nothing
Cells(lRow, 11) = "S"
Cells(lRow, 12) = "E-mail sent on: " & Now()
End If
End If
Next lRow
Set OutApp = Nothing
End Sub