I have this code (see below) that goes thru column L to see if the something is true or not and if it is true it sends an email to the email address in column 15. I am using my email address as a test to make sure it works and it is sending me 100's of emails. Is there anyway to have all the messages be sent in just one email?
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
x = Date
If x - Cells(3, 4) > 30 Then
Dim i As Long
For i = 7 To 368
If Range("L" & i) <= (Date - 365 * (3 * Range("N" & i)) - 182) Then
Address = Cells(i, 15)
strbody = "Relief Valve number " & Cells(i, 1) & " at " & Cells(i, 2) & " needs to be tested"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Address
.CC = ""
.BCC = ""
.Subject = "Pressure Relief Valve" 'Subject line'
.Body = strbody
.Attachments.Add ActiveWorkbook.FullName
.Send 'Sends Email"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next i
Cells(3, 4) = x
End If
End Sub
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
x = Date
If x - Cells(3, 4) > 30 Then
Dim i As Long
For i = 7 To 368
If Range("L" & i) <= (Date - 365 * (3 * Range("N" & i)) - 182) Then
Address = Cells(i, 15)
strbody = "Relief Valve number " & Cells(i, 1) & " at " & Cells(i, 2) & " needs to be tested"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Address
.CC = ""
.BCC = ""
.Subject = "Pressure Relief Valve" 'Subject line'
.Body = strbody
.Attachments.Add ActiveWorkbook.FullName
.Send 'Sends Email"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next i
Cells(3, 4) = x
End If
End Sub
