Send e-mails selected from a list in excel

[CookieMonster76]

Hi

I have the following in Columns A to D in a spreadsheet

A B C D
Supplier1@xxx.com Supplier 1 £10,000 x
Supplier2@yyy.com Supplier 2 £20,000
Supplier3@zzz.com Supplier 3 £30,000 x


I'd like to automate the sending of an e-mail, but only to those suppliers marked with an x in Column D - I needs to be a new e-mail for each supplier.

I have the code to send an e-mail to a fixed address. Is it possible to change the bold items below to be dynamic and to reference A1, B1 and C1 above?

.Subject = Title
.to = "Supplier1@xxx.com"
.CC = ""
.BCC = ""
.Subject = "Outstanding Invoices"
.Body = "Hi Supplier1" & vbLf & vbLf _
& "You currently owe £10,000." & vbLf & vbLf _
& "Please let me know if you have any queries." & vbLf & vbLf _
& "Thanks" & vbLf & vbLf _
& "Paul" & vbLf & vbLf

And then can I make it loop through and send e-mails to just the ones marked x in one go?

Thanks

Paul

 

[Sequoyah]

Hi Paul,
a classic example based on code created by Ron de Bruin

Sub CookieMonster76()
'https://www.mrexcel.com/board/threads/send-e-mails-selected-from-a-list-in-excel.1264750/
    
Dim OutApp          As Object, OutMail As Object
Dim sh              As Worksheet
Dim cell            As Range, FileCell As Range, rng As Range
    
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
    
    If cell.Value Like "?*@?*.?*" And _
       cell.Offset(0, 3).Value = "x" Then
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .to = cell.Value
        .Subject = "Title"
        .body = "Hi " & cell.Offset(0, 1).Value & vbLf & vbLf _
              & "You currently owe " & cell.Offset(0, 2).Value & vbLf & vbLf _
              & "Please Let Me know If you have any queries." & vbLf & vbLf _
              & "Thanks" & vbLf & vbLf _
              & "Paul" & vbLf & vbLf
        .Display        'Or use .Send
    End With
    
    Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub