Send each row an Excel Spreadsheet as an individual email in Outlook - excel

Question

I need a piece of code I can use to create a Macro that outputs each row of my spreadsheet below as an individual Outlook email, to the email address in the column titled "Email" below. I also need to add the columns titled, "Call", "Type", "Balance" and "Company Name" to the the body of the email.
I also need to add some free text to my email which is the same for each email sent: Body of email

Answer 1

The following procedure should accomplish this task. It is assumed that your data is stored in the columns A:G. If this is not the case, you will need to modify the specific parts accordingly. In addition, the code already includes the feature that the subject-varying part of the "body of the e-mail" is already in bold face.
Importantly, in its current state, the code only creates and displays the e-mails. If you want to send them, you need to change this part of the code from .Display to .Send (see comment in the code):
Sub sendOlMail()
Application.ScreenUpdating = False
Dim ws As Worksheet, olApp, olMail As Object, cell As Range, lr As Long, i As Integer, strBody1, strBody2 As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set olApp = CreateObject("Outlook.Application")
lr = Cells(Rows.Count, "G").End(xlUp).Row 'determine row with last value for loop
strBody1 = "Dear Sir/Madam,<br/><br/>" _
& "We are still awaiting payment from you for: <br/><br/>"
strBody2 = "Please can you provide us with an update? We have recently resent out invoice/card payment links as a gentle reminder. <br/><br/>" _
& "Please note it is a legal requirement for anyone using wireless radio equipment to hold a valid licence. On occasions we carry out site visits to ensure that any frequencies being used for wireless radio equipment are being used legally. <br/><br/>" _
& "Unfortunately, we may also have to look at revoking your company’s access to our Online Portal until such time as this payment is made. <br/><br/>" _
& "Kind Regards, Joe Bloggs"
For i = 2 To lr
Set olMail = olApp.CreateItem(0)
With olMail
.To = Range("G" & i).Value
.Subject = "E-Mail Subject" 'adjust subject of your e-mail
.htmlBody = strBody1 & "<b>" _
& Range("A" & i).Value & ", " & Range("C" & i).Value & ", " & Range("D" & i).Value & ", " & Range("E" & i).Value & "</b>" & "<br/><br/>" _
& strBody2
.Display 'change to .Send if you want to send out the e-mail
End With
Set olMail = Nothing
Next i
Application.ScreenUpdating = True
End Sub
EDIT: Adding additional functionality to the code based on comment
1: I have modified the .htmlBody element so that it also contains the headers of the respective categories. Instead of hard-coding the names of the headers, I take the headers directly from the Excel file (first row in the respective columns). The advantage of this specification is that it is dyanmically specified, which means that if you change the name of your heading in the Excel file, it will be automatically reflected.
2: Including the signature is a bit more tricky, but there are several ways to accomplish this. For this step, you should make sure that you specify your signature outside the loop, otherwise this will cause unnecessary overhead. You should also make sure that you declare your signature as a string variable.
(I) Retrieving the signature from the Outlook folder. This is a bit more complicated, but for me the better solution since the formatting of the signature is preserved (I have included this approach in the updated code).
(II) Retrieving the signature from the body of an email. The disadvantage of this method is that the formatting specified by the user is not preserved. However, if this is not an issue, this could be an even simpler solution. Then simply change the signature-related parts of the code with the following parts:
Set olMail = olApp.CreateItem(0)
olMail.Display
signature = olMail.Body
Set olMail = Nothing
The code with the additional functionalities (i.e., inclusion of headers and signature) looks as follows:
Sub sendOlMail()
Application.ScreenUpdating = False
Dim ws As Worksheet, olApp, olMail As Object, cell As Range, lr As Long, i As Integer, strBody1, strBody2, signature As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set olApp = CreateObject("Outlook.Application")
lr = Cells(Rows.Count, "G").End(xlUp).Row 'determine row with last value for loop
' prepare signature
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then signature = signature & Dir$(signature & "*.htm") Else signature = ""
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
strBody1 = "Dear Sir/Madam,<br/><br/>" _
& "We are still awaiting payment from you for: <br/><br/>"
strBody2 = "Please can you provide us with an update? We have recently resent out invoice/card payment links as a gentle reminder. <br/><br/>" _
& "Please note it is a legal requirement for anyone using wireless radio equipment to hold a valid licence. On occasions we carry out site visits to ensure that any frequencies being used for wireless radio equipment are being used legally. <br/><br/>" _
& "Unfortunately, we may also have to look at revoking your company’s access to our Online Portal until such time as this payment is made. <br/><br/>" _
& "Kind Regards, Joe Bloggs"
For i = 2 To lr
Set olMail = olApp.CreateItem(0)
With olMail
.To = Range("G" & i).Value
.Subject = "E-Mail Subject" 'adjust subject of your e-mail
.htmlBody = strBody1 & "<b>" _
& Range("A" & 1).Value & ": " & Range("A" & i).Value & ", " _
& Range("C" & 1).Value & ": " & Range("C" & i).Value & ", " _
& Range("D" & 1).Value & ": " & Range("D" & i).Value & ", " _
& Range("E" & 1).Value & ": " & Range("E" & i).Value & "</b>" & "<br/><br/>" _
& strBody2 & "<br/><br/>" _
& signature
.Display 'change to .Send if you want to send out the e-mail
End With
Set olMail = Nothing
Next i
Application.ScreenUpdating = True
End Sub