how to send each row by email

[BARIS]

Hi Again,
How can I add cell C(i) to subject line into each email?
What I need to print to subject field for the first line is, for example, "customer11, expired account" etc..
Here is the script and the excel file I run in my pc:

Sub SendEmailRowByRow()
    
    Dim OutApp      As Object
    Dim OutMail     As Object
    Dim strBody     As String
    Dim LastRow     As Long
    Dim eMailIDs, i As Long
    Dim varBody
    
    Const StartRow  As Long = 1     '<<< adjust to suit
    
    
    If Not Application.Intersect(Range("I:I"), ActiveSheet.UsedRange) Is Nothing Then
        
        LastRow = Range("I" & Rows.Count).End(xlUp).Row
        
        eMailIDs = Range("I" & StartRow).Resize(LastRow - StartRow + 1)
        
        For i = 1 To UBound(eMailIDs, 1)
            
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            
            varBody = Range("a" & StartRow + i - 1).Resize(, 7).Value
            strBody = Join(Application.Transpose(Application.Transpose(varBody)), vbTab)
            On Error Resume Next
            With OutMail
                .To = eMailIDs(i, 1) 'email from corresponding row goes here
                .CC = ""
                .BCC = ""
                .Subject = "Expired account notification"    '<< adjust subject line
                .Body = strBody
                'You can add a file like this
                '.Attachments.Add ("C:\")
'                .Display
                .Send
                Application.Wait Now + TimeSerial(0, 0, 3)
                Set OutMail = Nothing
                Set OutApp = Nothing
            End With
            On Error GoTo 0
        Next
    End If
    
End Sub