Send email using VBA when combination of cell vaues is true - excel

Question

My sheet 'Volglijst' contains a list with all packages that have been registerd for sending.
When the package is picked up by the supplier or courrier, the goods reception service registers the date and who picked up the package.
When they close the file, a pop-up appears that is asking if they want to send e-mail confirmation to the person who requested the sending.
When they select yes VBA should check all rows in sheet 'Volglijst' where there is a date in Column B and Column Q, and where column S is empty (the 3 conditions should apply at the same time, if not, no e-mail needs to be send).
I'm getting my outlook to start and create a new e-mail, but it remains empty.
The body is working for an other e-mail only the reference to the cell content is adjusted to match the rows for which the conditions apply.
Dim OutApp As Object
Dim OutMail As Object
Dim i As Long
Dim t As Range
Dim WkSht As Worksheet
Dim strbody As String
Set WkSht = Sheets("Volglijst")
For i = 1 To 999
If WkSht.Cells(i, 2).Value <> "" And WkSht.Cells(i, 17).Value <> "" And WkSht.Cells(i, 19).Value = "" Then
Dim rng As Range
With Application.Intersect(WkSht.Rows(i), WkSht.UsedRange)
Set rng = WkSht.Range(WkSht.Cells(i, 3), .Cells(.Cells.Count))
End With
If rng Is Nothing Then
Exit Sub
End If
End If
Next
On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Beste Collega,<br><br>" & _
"Uw pakket met nummer <B>" & WkSht.Cells(WkSht.Rows(i), 1).Value & "</B> werd <B>" & WkSht.Cells(WkSht.Rows(i), 17).Value & "</B> opgehaald door <B>" & WkSht.Cells(WkSht.Rows(i), 16).Value & "</B>.<br>" & _
"Bijkomende opmerkingen goederenontvangst: <B>" & WS.Cells(WkSht.Rows(i), 18).Value & "</B>.<br>" & _
"<br><br>In geval van vragen gelieve contact op te nemen." & _
"<br><br> Met vriendelijke groeten, </font>"
On Error Resume Next
With OutMail
.To = WS.Cells(WkSht.Rows(i), 5).Value
.CC = ""
.BCC = ""
.Subject = "Ophaling pakket " & WS.Cells(i, 1).Value & ""
.HTMLBody = strbody
.Display 'or use .Send
End With
A separate email sould be sent for each row with column B <> ""; column Q <> "", Column S = "" , and the recepient is the e-mail adres of column E in that row. Details in the email body should also come from the applicable row.

Answer 1

Will attempt to compartmentalize this, but you have a couple significant issue:
You utilize i in the outlook aspect of this email OUTSIDE of the loop, so you're just using i = 999, or was this intended to be within the loop?
The references in your strbody were to different worksheets... check your references. I called out the first occurrence in the Excel_Activities subroutine when I started defining each use.
Public bdy_a as string, bdy_b as string, bdy_c as string, bdy_d as string
Public to_ as string
Public sub_ as string
'
Sub Excel_Activities()
Dim i as Long, t As Range
Dim WkSht As Worksheet
Dim strbody As String
Set WkSht = Sheets("Volglijst")
For i = 1 To 999
If WkSht.Cells(i, 2).Value <> "" And WkSht.Cells(i, 17).Value <> "" And WkSht.Cells(i, 19).Value = "" Then
Dim rng As Range
With Application.Intersect(WkSht.Rows(i), WkSht.UsedRange)
Set rng = WkSht.Range(WkSht.Cells(i, 3), .Cells(.Cells.Count))
End With
If rng Is Nothing Then
Exit Sub
Else
bdy_a = WkSht.Cells(i, 1).Value
bdy_b = WkSht.Cells(i, 17).Value
bdy_c = WkSht.Cells(i, 16).Value
bdy_d = WS.Cells(i, 18).Value 'IS THIS CORRECT SHEET?
to_ = WS.Cells(WkSht.Rows(i), 5).Value
sub_ = WS.Cells(i, 1).Value
Application.Run("Outlook_Activities")
End If
End If
Next
End Sub
Then deal with the saved values to create the desired email, which appears to occur within the Loop based on the use of i in your original post strbody.
Private Sub Outlook_Activities()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & "Beste Collega,<br><br>" & "Uw pakket met nummer <B>" & bdy_a & "</B> werd <B>" & bdy_b & "</B> opgehaald door <B>" & bdy_c & "</B>.<br>" & "Bijkomende opmerkingen goederenontvangst: <B>" & & "</B>.<br>" & "<br><br>In geval van vragen gelieve contact op te nemen." & "<br><br> Met vriendelijke groeten, </font>"
With OutMail
.To = to_
.CC = ""
.BCC = ""
.Subject = "Ophaling pakket " & sub_ & ""
.HTMLBody = strbody
.Display 'or use .Send
End With
End Sub

Answer 2

I believe the following is what you are looking for, this will loop from Row 1 to the last in the UsedRange, check whether Columns B & Q are not empty and Column S is empty then deal with the email per row:
Sub LoopThroughRange_SendEmail()
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
Dim i As Long
Dim strbody As String
Dim WkSht As Worksheet: Set WkSht = Sheets("Volglijst")
For i = 1 To WkSht.UsedRange.Rows.Count
If WkSht.Cells(i, "B").Value <> "" And WkSht.Cells(i, "Q").Value <> "" And WkSht.Cells(i, "S").Value = "" Then
strbody = "<html><body><font size=""3"" face=""Calibri"">Beste Collega,<br><br>Uw pakket met nummer <b>" & _
WkSht.Cells(i, "A").Value & "</b> werd <b>" & WkSht.Cells(i, "Q").Value & "</b> opgehaald door <b>" & _
WkSht.Cells(i, "P").Value & "</b>.<br>Bijkomende opmerkingen goederenontvangst: <b>" & _
WkSht.Cells(i, "R").Value & "</B>.<br><br><br>In geval van vragen gelieve contact op te nemen.<br><br>" & _
"Met vriendelijke groeten, </font></body></html>"
With OutMail
.To = WkSht.Cells(i, "E").Value
.CC = ""
.BCC = ""
.Subject = "Ophaling pakket " & WkSht.Cells(i, "A").Value & ""
.HTMLBody = strbody
.Display 'or use .Send
End With
End If
Next i
End Sub
UPDATE:
To also validate the email address before attempting to send the email, the below will help, it will allow multiple email addresses in a single cells separated by a ;
Sub LoopThroughRange_SendEmail()
Dim oRegEx As Object
Set oRegEx = CreateObject("VBScript.RegExp")
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
Dim i As Long
Dim strbody As String
Dim WkSht As Worksheet: Set WkSht = Sheets("Volglijst")
For i = 1 To WkSht.UsedRange.Rows.Count
If ValidEmail(WkSht.Cells(i, "E").Value, oRegEx) Then
If WkSht.Cells(i, "B").Value <> "" And WkSht.Cells(i, "Q").Value <> "" And WkSht.Cells(i, "S").Value = "" Then
strbody = "<html><body><font size=""3"" face=""Calibri"">Beste Collega,<br><br>Uw pakket met nummer <b>" & _
WkSht.Cells(i, "A").Value & "</b> werd <b>" & WkSht.Cells(i, "Q").Value & "</b> opgehaald door <b>" & _
WkSht.Cells(i, "P").Value & "</b>.<br>Bijkomende opmerkingen goederenontvangst: <b>" & _
WkSht.Cells(i, "R").Value & "</B>.<br><br><br>In geval van vragen gelieve contact op te nemen.<br><br>" & _
"Met vriendelijke groeten, </font></body></html>"
With OutMail
.To = WkSht.Cells(i, "E").Value
.CC = ""
.BCC = ""
.Subject = "Ophaling pakket " & WkSht.Cells(i, "A").Value & ""
.HTMLBody = strbody
.Display 'or use .Send
End With
End If
Else
'email address is not valid
End If
Next i
End Sub
Public Function ValidEmail(pAddress As String, ByRef oRegEx As Object) As Boolean
With oRegEx
.Pattern = "^(([a-zA-Z0-9_\-\.\']+)#((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)(\s*;\s*|\s*$))+$" 'pattern for multiple email addresses included
ValidEmail = .test(pAddress)
End With
End Function