How to send personalized emails from Excel? - excel

Question

I have a list of mangers names and email addresses with employees who did not submit their time sheet.
I need a code to create email to each manger with the name of the employees that did not submit their time-sheet. Any advice? The file looks like below
approval name Approval Email address Employee name
test 1 test#yahoo Test 11
test 2 test#hotmail.com test 10
test 3 test#gmail.com test 9
How to change code to send to each member instead of one email
sub sendmultiple()
'
Dim xOTApp As Object
Dim xMItem As Object
Dim xCell As Range
Dim xRg As Range
Dim xEmailAddr As String
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xOTApp = CreateObject("Outlook.Application")
For Each xCell In xRg
If xCell.Value Like "*#*" Then
If xEmailAddr = "" Then
xEmailAddr = xCell.Value
Else
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
Next
Set xMItem = xOTApp.CreateItem(0)
With xMItem
.To = xEmailAddr
.Display
End With
End Sub

Answer 1

Since this looks like homework, I'll give you a non-functional sample that shows you the general structure
Sub sendmultiple()
Dim lRow As Long
Dim oMailItem As Object
lRow = 2
[code to create Outlook application object goes here]
Do Until Range("A" & lRow) = ""
[code to Set oMailItem goes here]
With oMailItem
.To = Range("B" & lRow) ' the email address it goes to
.Subject = Range("A" & lRow) ' the name of approval person, not sure why
.HTMLBody = Range("C" & lRow) ' the person the email is about
.Send
End With
lRow = lRow + 1
Loop
End Sub

Answer 2

With a small modification, you should be able to get this to do exactly what you want.
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
https://www.rondebruin.nl/win/s1/outlook/amail6.htm