Column G           Column W
File1.xls          [email protected]
File2.xls          [email protected]
File3.xls          [email protected]
File4.xls          [email protected]

End with without with

End With

Sub email()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016

'Variables
    Dim cell As Range



     Application.ScreenUpdating = False

    Dim Maildb As Object
    Dim MailDoc As Object
    Dim Body As Object
    Dim Session As Object
'Start a session of Lotus Notes
    Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
    Call Session.Initialize
'or use below to provide password of the current ID (to avoid Password prompt)
    'Call Session.Initialize("<password>")
'Open the Mail Database of your Lotus Notes
    Set Maildb = Session.GETDATABASE("", "D:NotesdataMaileXceLiTems.nsf")
    If Not Maildb.IsOpen = True Then
    Call Maildb.Open
    End If



    'Loop

    On Error GoTo cleanup
    For Each cell In Columns("V").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "G").Value) <> "" Then


           'Email COde


            Set MailDoc = Maildb.CREATEDOCUMENT
    Call MailDoc.REPLACEITEMVALUE("Form", "Memo")
'Set the Recipient of the mail
    Call MailDoc.REPLACEITEMVALUE("SendTo", cell.Value)
'Set subject of the mail
    Call MailDoc.REPLACEITEMVALUE("Subject", "Attention Required: Promotion Announcement for Week " & Range("O10").Value & " " & Range("O13").Value)
'Create and set the Body content of the mail
    Set Body = MailDoc.CREATERICHTEXTITEM("Body")


    'Email Body

    Call Body.APPENDTEXT("Good " & Range("A1").Value & "," _
                      & vbNewLine & vbNewLine & _
                      "Thank you for your interest in participating in this weeks special promotion. Please see the details below." _
                      & vbNewLine & vbNewLine _
                                     & vbNewLine & vbNewLine _
                      & Range("I10").Value _
                      & vbNewLine & vbNewLine _
                      & "Thank you and kind regards / Danke und freundliche Grüße," _
                      & vbNewLine & vbNewLine _
                      & "The Food Specials Team" _
                      & vbNewLine)


    'End Email Body



'Example to create an attachment (optional)
    Call Body.ADDNEWLINE(2)
    Call Body.EMBEDOBJECT(1454, "", Filename, cell.Offset(0, -19).Value)
'Example to save the message (optional) in Sent items
    MailDoc.SAVEMESSAGEONSEND = True
'Send the document
'Gets the mail to appear in the Sent items folder
    Call MailDoc.REPLACEITEMVALUE("PostedDate", Now())
    Call MailDoc.SEND(True)
'Clean Up the Object variables - Recover memory




            'End Loop

            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

    Next cell

cleanup:
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set Body = Nothing
    Set Session = Nothing

    Application.ScreenUpdating = True

End Sub