Email with Attachments

Sub SendEmailWithAttachments()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim i As Long, lastRow As Long
    Dim filePath As String

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set OutApp = CreateObject("Outlook.Application")

    For i = 2 To lastRow
        filePath = ws.Cells(i, 4).Value ' Assuming file path is in column D

        If Dir(filePath) <> "" Then ' Check if file exists
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = ws.Cells(i, 2).Value
                .Subject = ws.Cells(i, 3).Value
                .Body = "Please find attached file."
                .Attachments.Add filePath
                .Send
            End With
            Set OutMail = Nothing
        End If
    Next i

    MsgBox "Emails with attachments sent!"
End Sub