I am attempting to send an email about mailing addresses to send physics kits to students. The .oft template I am using has the required information regarding posting their physics kits. I need a macro to open the email for each student and send it to their university email address (column A), cc to their personal email address (column B), have their name (column C) & "- Physics kit information" as the subject as a minimum. I would also like to add their name into the body from the existing template (as in "Hi Jerry, Please information below regarding your physics kit, etc "
The code I have below (from an earlier project where I just needed staff names and outlook sorted the rest) lets me open the template for each address I select and works perfectly. However I can't figure how to get the CC and subject from other cells in the same row or how to add "Hi " to the start of the email body from the template. Can anyone help me please?
Sub SendEmailToAddressInCells()
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
Dim subj As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select email address range", "Who do you want to send the email to?", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each xRgEach In xRg
xRgVal = xRgEach.Value
If xRgVal <> " " Then
Set xMailOut = xOutApp.CreateItemFromTemplate("C:\Work\2022\Physics kits\Physics Kit.oft")
With xMailOut
.To = xRgVal
.Subject = xRgVal & " - Physics kit information"
.Display
'.Send
End With
End If
Next
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub