发送电子邮件到单元格中的电子邮件地址（如果有）

Question

I have three columns("O", "Q", "S") that use VLOOKUP to get the email address from people's names input. I want these people to all be emailed one email with some details.

I don't want this code to run if there are no email values in any of the three columns. I'd like the code to run if any of the three columns has an email address.

This code checks if a cell contains an email address and then sends that email address an email. I need this for all three of the cells & I need them to all be emailed together.

If emailbox.Value = True Then

    On Error Resume Next
    i = ActiveCell.Row                  'VLOOKUP
    Sheet2.Cells(i, 15).Value = Application.WorksheetFunction.VLookup(Sheet2.Cells(i, 14).Value, Sheet3.Range("AMS"), 2, 0)

    On Error Resume Next
    i = ActiveCell.Row                  'VLOOKUP
    Sheet2.Cells(i, 17).Value = Application.WorksheetFunction.VLookup(Sheet2.Cells(i, 16).Value, Sheet3.Range("AQE"), 2, 0)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

    For Each cell In Sheet2.Range("O" & ActiveCell.Row)
        If cell.Value Like "?*@?*.?*" Then 'Check cell for email address

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = cell.Value
                .Subject = "SUBJECT"
                .Body = "Dear...."
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing

            sent.Visible = True
            Else
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End If

Answer 1

Loop through each cell in column O , and test all three cells for an email, when it encounters an email it will execute the rest of the code, and exit the inner loop.

Dim cel As Range, lRow As Long, x As Long
lRow = ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row

    For Each cel In Range("O2:O" & lRow)
        For x = 15 To 19 Step 2 'loop through each cell in the active row

            If Cells(cel.Row, x).Value Like "?*@?*.?*" Then
                'email .To = Cells(cel.Row, x).Value
                Exit For 'exits the inner loop when the condition is met
            End If

        Next x

    Next cel