To Answer Your Question:

I think the reason you are only seeing one email is because you only created one OutMail object. If you want to loop, you need to set the object = nothing before you can create a new one:

Set OutMail = Nothing

It also looks like you are creating a single dictionary that has all of the emails pushed together in the email field, the names pushed together, etc. You need a way to loop through each email you want to send. You could create an array of dictionaries, create a collection of objects, or loop through a range where the data is kept. Looping through a range sounds like it would be the least complicated in this case.

The pseudocode/code looks like this:

'instantiate the outlook object. Use:
Set OutApp = CreateObject("Outlook.Application")

'Create your array of dictionaries or return a range with the data
'Let's call it listOfEmails

For each email in listOfEmails:

    'instantiate the mail object. Use:
    Set OutMail = OutApp.CreateItem(0)

    'The block that creates the email:
    With OutMail
        .To = strEmailTo
        .CC = strCCTo
        .BCC = ""
        .Subject = strToday & " - Agreement"
        .Body = strbody
        '.Attachments.Add
        .Display
     End With

    'destroy the object when you are done with that particular email
    Set OutMail = Nothing

Next email


Set OutApp = Nothing

Some General Advice:

Breaking your code into smaller pieces can help make things easier to fix and read. It also makes it more reusable for both this project and future projects. I'm including this feedback because it also makes for easier questions to answer on here.

For example:

A function to check if Outlook is open:

Function isOutlookOpen() As Boolean
'returns true or false if Outlook is open

    Dim OutApp As Object

    On Error Resume Next
    Set OutApp = CreateObject("Outlook.Application")

    If OutApp Is Nothing Then
        isOutlookOpen = False
    Else: isOutlookOpen = True
    End If
    On Error GoTo 0

End Function

A subroutine to send the email that you can call from another sub:

Sub sendEmail(ByVal recTO As String, ByVal subjectContent As String, ByVal bodyContent As String)

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = recTO
        '.CC = ""
        '.BCC = ""
        .subject = subjectContent
        .body = bodyContent '.HTMLBody
        .display
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

A function to return a range of data:

Function dataRange() As Range
'Returns the range where the data is kept

    Dim ws As Worksheet
    Dim dataRng As Range
    Dim lastRow As Integer
    Dim rng As Range

    Set ws = Workbooks("outlookEmail.xlsm").Sheets("dataSheetName")
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row

    'still select where the data should go if the data range is empty
    If lastRow = 2 Then
    lastRow = lastRow + 1
    End If

    Set dataRange = Range("B3", "G" & lastRow)

End Function

A subroutine to bring it all together:

Sub main()
'This sub does more than one thing, but I'm asuming it's extremely custom ans still relatively short

    Dim data As Range
    Dim subj As String
    Dim recEmail As String
    Dim body As String
    Dim Row As Range

    'check if data exists. Exit the sub if there's nothing
    Set data = dataRange
    If dataRange.Cells(1, 1).Value = "" Then
    MsgBox "Data is empty"
    Exit Sub
    End If

    'Loop through the data and send the email.
    For Each Row In data.Rows
        'Row is still a range object, so you can access the ranges inside of it like you normally would

        recEmail = Row.Cells(1, 2).Value

        If recEmail <> "" Then 'if the email is not blank, send the email
            subj = Format(Date, "mm.dd.yy") & " - Agreement"
            body = "Dear " & Row.Cells(1, 4).Value & "," & vbNewLine & vbNewLine & _
                "Say Hello World!" & vbNewLine & vbNewLine & _
                "Kind Regards," & vbNewLine & _
                "Mr A Nother"

            Call sendEmail(recEmail, subj, body)
        End If
    Next Row

End Sub

Very Importantly:

Thank you to Ron De Bruin for teaching me all about sending emails from Outlook using code in Excel VBA

First of all, add

Option Explicit

above all code. Then correct the errors. Then: https://stackoverflow.com/help/mcve

You want to use Excel VBA to achieve Outlook mail delivery? if so, You can use the following method to get the email address in range.

You can not be so troublesome. You have simpler code to implement.

        Sub Send_Email()
        Dim rng As Range
        For Each rng In Range("C1:C4")
                   Call mymacro(rng)
        Next rng
    End Sub
 Private Sub mymacro(rng As Range)
        Dim OutApp As Object
        Dim OutMail As Object
        Dim MailBody As String
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        MailBody = "hello"
        On Error Resume Next
        With OutMail
            .To = rng.Value
            .CC = ""
            .BCC = ""
            .Subject = Sheet1.Cells(rng.Row, 1).Value
            .Body = Sheet1.Cells(rng.Row, 2).Value
            .Display
            '.Send
        End With
        On Error GoTo 0
        Set xOutMail = Nothing
        Set xOutApp = Nothing
    End Sub

I use the mymacro method to create a message and send it.

I loop through the email addresses("C1:C4").And call mymacro method to send an email to this address.