How to loop and create an Outlook message body - vba

Question

I am trying to loop a list from a sheet into a Outlook Body, but I just loops through until the end and show the last one...
Any ideas?
Sub SendEmail()
Dim ws As Worksheet
Set ws = Worksheets("PrestageData")
strUsed = ws.UsedRange.Rows.Count
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
EmailItem.To = frmForm.txtCollector.Value & "mail.dk"
'EmailItem.CC = "hello#gmail.com"
'EmailItem.BCC = "hhhh#gmail.com"
EmailItem.Subject = "Din FAP er klar til afhentning"
For i = 2 To strUsed
If ws.Cells(i, 4).Value = "KLAR" Then
strReady = ws.Cells(i, 1).Value
EmailItem.HTMLBody = "Hej," & frmForm.txtCollector.Value & "<br><br>" & "Følgende FAP er klar: " & strReady
'Source = ThisWorkbook.FullName
'EmailItem.Attachments.Add Source
End If
Next
EmailItem.Display
End Sub

Answer 1

You are missing an Exit For to leave the loop after the first find:
For i = 2 To strUsed
If ws.Cells(i, 4).Value = "KLAR" Then
strReady = ws.Cells(i, 1).Value
EmailItem.HTMLBody = "Hej," & frmForm.txtCollector.Value & "<br><br>" & "Følgende FAP er klar: " & strReady
Exit For
End If
Next
In case you want to capture multiple matching entries, you have to extend the body rather than replacing it in full. You could append an extra line per entry.

Answer 2

It seems every time in the loop you overwrite the message body. Instead, you need to append the message body with a content found in the worksheet:
EmailItem.HTMLBody = "Hej," & frmForm.txtCollector.Value
For i = 2 To strUsed
If ws.Cells(i, 4).Value = "KLAR" Then
strReady = ws.Cells(i, 1).Value
EmailItem.HTMLBody = EmailItem.HTMLBody & "<br><br>" & "Følgende FAP er klar: " & strReady
'Source = ThisWorkbook.FullName
'EmailItem.Attachments.Add Source
End If
Next
But I'd suggest playing a well-formed HTML markup in the code and find the closing tag in the HTMLBody string and paste your add-in there. For example, you could use the Replace function available in VBA:
EmailItem.HTMLBody = Replace(EmailItem.HTMLBody, "</body>", "<br><br>" & "Følgende FAP er klar: " & strReady & "</body>")