Mail adresi olmayanlara mail göndermesin

[tahsinanarat]

Sub SendEmailfromOutlook()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim Path As String
    Path = Application.ActiveWorkbook.Path
    Set OutApp = CreateObject("Outlook.Application")
    Set s1 = Sheets("Toplu_mail")
    son = s1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each cell In s1.Range("E2:E" & son)
        Set OutMail = OutApp.CreateItem(0)
              With OutMail
                .To = cell.Value
                .Subject = Cells(cell.Row, "D").Value
                .Body = "Selam " & Cells(cell.Row, "B").Value & "," _
                      & vbNewLine & vbNewLine & _
                        "Lütfen bu e-postanın ekindeki Mutabakat bilgilerinize bakın. Teşekkür ederim!"
                .Attachments.Add (Cells(cell.Row, "G").Value)
                '.Send
                .Display
            End With
    Next cell
   
End Sub

E sutununda Mail adreslerine göre otomatik mail gönderiyor, ancak mail adresleri olmayanları atlaması (göndermemesi) için nasıl bir değişiklik yapmalıyım.
Teşekkürler

 

[AdemCan]

Merhaba, döngü içinde kırmızı renk ile belirttiğim satırları ekleyip boş olan hücreleri geçebilirsiniz.

    For Each cell In s1.Range("E2:E" & son)
        If cell.Value = "" Then GoTo atla
        Set OutMail = OutApp.CreateItem(0)
              With OutMail
                .To = cell.Value
                .Subject = Cells(cell.Row, "D").Value
                .Body = "Selam " & Cells(cell.Row, "B").Value & "," _
                      & vbNewLine & vbNewLine & _
                        "Lütfen bu e-postanın ekindeki Mutabakat bilgilerinize bakın. Teşekkür ederim!"
                .Attachments.Add (Cells(cell.Row, "G").Value)
                '.Send
                .Display
            End With
atla:
    Next cell

 

[tahsinanarat]

Sn. @AdemCan, istediğim gibi oldu, çok teşekkür ediyorum. Sağolun.

 

[AdemCan]

Rica ederim.