Send email using VBA when combination of cell vaues is true

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.

Comment out On Error Resume Next - do you get an error and what is the error message? — BigBen
I would highly recommend compartmentalizing this, where one subroutine contrains Excel activities and a separate for Outlook activities; this will help in overall troubleshooting. Set ranges, or save the values in variables to be utilized in the email, where possible, as this prevents having to go back and forth between the two applications. — Cyril

Cyril Cyril · Accepted Answer · 2019-10-25T14:49:37

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

Send email using VBA when combination of cell vaues is true

2 Answers