Email Automation

Sub SendAutomatedEmails()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

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

    For i = 2 To lastRow
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = ws.Cells(i, 2).Value
            .Subject = "Monthly Update - " & ws.Cells(i, 1).Value
            .Body = "Dear " & ws.Cells(i, 1).Value & "," & vbCrLf & _
                    "Your monthly summary is ready." & vbCrLf & _
                    "Total: " & ws.Cells(i, 3).Value
            .Send
        End With
        Set OutMail = Nothing
    Next i

    Set OutApp = Nothing
    MsgBox "Emails sent successfully!"
End Sub