VBA Email Loop for excel reporting - vba

Question

I created a macro that would run a report for a selected indivdual and send that person an email with that package. This report is meant for roughly 20 people, but it has been tedious to run the report for each person and then send it.
I was wondering if there was a way to type names in cells of the people I want to run the report to and have excel loop through each one and send that report to the selected individual and then loop to the next one.
Is this possible, and if so how would I go about creating this macro.
Thank you for your aid

Answer 1

Perhaps you can adjust the code below for your needs. It will send the contents of a textbox on the ActiveSheet to a list of emails in column A. To use it you have to set up your sending email account in Outlook.
Option Explicit
'how to send an email to a list of recipients based on data
'stored in a workbook. The recipient email addresses must
'be in column A, and the body text of the email must be in
'the first text box on the active sheet.
Sub Sample()
Dim olApp As Object, olMailItm As Object, i As Integer, j As Integer
Dim r As Range, s As String, numRows As Integer, numCols As Integer
Dim Dest As Variant, emailAddr As String, txtBox As Shape
'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
Set txtBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
200, 100, 400, 100)
'.TextFrame.TextRange.Text = "Test Box"
'Using the email, add multiple recipients, using a list of addresses in column A.
Set r = Range("B1")
s = "": numCols = 4: numRows = 4
For j = 1 To numCols
For i = 1 To numRows
If i > 1 Then s = s & vbTab
s = s & r.Offset(j, i)
Next i
s = s & vbCr
Next j
txtBox.TextFrame2.TextRange.Characters.Text = s
With olMailItm
emailAddr = ""
For i = 1 To WorksheetFunction.CountA(Columns(1))
If emailAddr = "" Then
emailAddr = Cells(i, 1).Value
Else
emailAddr = emailAddr & ";" & Cells(i, 1).Value
End If
Next i
'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
.BCC = emailAddr
.Subject = "FYI"
'.body = txtBox.Text
.body = ActiveSheet.TextBoxes(1).Text
.Send
End With
'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub