How to loop and create an Outlook message body-CodePudding

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 = "[email protected]"
'EmailItem.BCC = "[email protected]"
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

CodePudding user response：

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.

CodePudding user response：

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>")