VBA to Outlook - Help with Looping

Hi, I am a relatively new user and am needing help in looping a macro which will send customized emails to a list of recipients using data from Excel.

I am using the code below, which works perfectly for the first row. However when Outlook opens, it generates identical emails on an endless loop. The intention is to send emails to all the recipients in Column P using the data from other columns until it reaches an empty row or cell.

Any suggestions would be greatly appreciated! Thanks.

Sub SendEmails_Click()

Dim i As Integer
Dim email, body, subject, copy, EEfirst, EElast, GDIbldgname, GDIbldgnumb, HRCbldgname, HRCbldgnumb As String
Dim OutApp As Object
Dim OutMail As Object

body = ActiveSheet.TextBoxes("TextBox 1").Text

i = 2

Do While Cells("P12").Value <> ""

    email = Range("P12").Value
    subject = Range("AB12").Value
    copy = Range("H12").Value
    EEfirst = Range("U12").Value
    EElast = Range("W12").Value
    GDIbldgname = Range("X12").Value
    GDIbldgnumb = Range("D12").Value
    HRCbldgname = Range("Y12").Value
    HRCbldgnumb = Range("C12").Value

    body = Replace(body, "U12", EEfirst)
    body = Replace(body, "W12", EElast)
    body = Replace(body, "X12", GDIbldgname)
    body = Replace(body, "D12", GDIbldgnumb)
    body = Replace(body, "Y12", HRCbldgname)
    body = Replace(body, "C12", HRCbldgnumb)

Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.createitem(0)
    With OutMail
         .To = email
         .cc = copy
         .subject = subject
         .body = body
         .display
         '.Send
    End With
    
        body = ActiveSheet.TextBoxes("TextBox 1").Text
        i = i + 1
    Loop
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    MsgBox "Email(s) Sent!"

End Sub