VBA sending an email of two conditions are met

Steve N

New Member
Joined
Nov 3, 2024
Messages
2
Office Version
  1. 2021
Platform
  1. Windows
I'd be really grateful if some one could help me with this, I've been trying to work it out for a while but I'm not getting anywhere. I have a VBA to send an email based on individual rows and the data they contain.
I'd like a way of sending individual emails to all recipients and the data on their line if two conditions in their line are met - that Its been confirmed in column G and that no email has been sent; column H is empty. I'd like to do this with one button rather than creating a button for each line.

My VBA:
Sub SendEmailFromExcel()

Dim OutApp As Object, OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
if
.To = Range("E1").Value
.CC = Range("R1").Value
.Subject = Range("R1").Value
.Body = Range("J3") & vbNewLine & vbNewLine & _
Range("K2") & vbNewLine & _
Range("L2") & vbNewLine & _
Range("M2") & vbNewLine & _
Range("N2") & vbNewLine & _
Range("O2") & vbNewLine & vbNewLine & _
"Many Thanks,"
.Display
'.Send
End With

Set OutApp = Nothing
Set OutMail = Nothing

End Sub
 

Attachments

  • VBA questions.JPG
    VBA questions.JPG
    153.9 KB · Views: 12

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Try:
VBA Code:
Sub SendEmailFromExcel()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, v As Variant, i As Long
    v = Range("E2", Range("E" & Rows.Count).End(xlUp)).Resize(, 11).Value
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    For i = LBound(v) To UBound(v)
        If v(i, 3) <> "" And v(i, 4) = "" Then
            With OutMail
                .To = v(i, 1)
                .cc = Range("Q1").Value
                .Subject = Range("R1").Value
                .HTMLBody = v(i, 6) & "<br><br>" & v(i, 7) & "<br>" & v(i, 8) & "<br>" & v(i, 9) & "<br>" & v(i, 10) & "<br>" & v(i, 11) _
                & "<br><br>" & "Many Thanks,"
                .Display
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
VBA Code:
Sub SendEmailFromExcel()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, v As Variant, i As Long
    v = Range("E2", Range("E" & Rows.Count).End(xlUp)).Resize(, 11).Value
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    For i = LBound(v) To UBound(v)
        If v(i, 3) <> "" And v(i, 4) = "" Then
            With OutMail
                .To = v(i, 1)
                .cc = Range("Q1").Value
                .Subject = Range("R1").Value
                .HTMLBody = v(i, 6) & "<br><br>" & v(i, 7) & "<br>" & v(i, 8) & "<br>" & v(i, 9) & "<br>" & v(i, 10) & "<br>" & v(i, 11) _
                & "<br><br>" & "Many Thanks,"
                .Display
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Hi Mumps, thank you so much for this I tweaked it to fit my actual sheet and it works perfectly, very much appreciated!
 
Upvote 0
Hi @mumps,, in this case it works the same, but I think the line
VBA Code:
Set OutMail = OutApp.CreateItem(0)
should be placed inside the loop after the If condition check (as in your response in this thread Add a table to e-mail to be sent to multiple addreses). Try to see what would happen if you add an attachment.

Code:
Sub SendEmailFromExcel()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, v As Variant, i As Long
    v = Range("E2", Range("E" & Rows.Count).End(xlUp)).Resize(, 11).Value
    Set OutApp = CreateObject("Outlook.Application")
    
    For i = LBound(v) To UBound(v)
        If v(i, 3) <> "" And v(i, 4) = "" Then
            Set OutMail = OutApp.CreateItem(0)
......
 
Upvote 0

Forum statistics

Threads
1,224,271
Messages
6,177,620
Members
452,786
Latest member
k3calloway

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top