MultiAttachment Distribution of varing files to multiple recipients - excel

Question

I have researched this topic and found great code - but not quite what I need. I have created an Excel file to setup a range for email distribution of an attachment to 3 hundred recipients - which works fine. But I have multiple attachments which need to go to the same recipient. Column A is the field where the file name is chosen - which picks up a pdf for recipient 1. Is it possible to use Column B for the second pdf file for recipient 1 and how do I loop that in?
Sub Mail_Report()
Dim OutApp As Object
Dim OutMail As Object
'Use presence of a Path to determine if a mail is sent.
Set Rng = Range(Range("J2"), Range("J" & Rows.Count).End(xlUp))
For Each cell In Rng
Rw = cell.Row
Path = cell.Value
If Path <> "" Then
'Get Date info from Path
'Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
'Get Territory to check for filename (Column A)
FilNmeStr = cell.Offset(0, -9).Value
'Email Address
ToName = cell.Offset(0, -5).Value
'Subject Line
SL = Cells(1, "K")
'Create Recipient List
For x = 1 To 4
Recp = cell.Offset(0, -x).Value
If Recp <> "" Then
Recp = cell.Offset(0, -x).Value
End If
RecpList = RecpList & ";" & Recp
Next
ccTo = RecpList
'Get Name
FirstName = cell.Offset(0, -7).Value
LastName = cell.Offset(0, -6).Value
'Loop through files in Path to see if
ClientFile = Dir(Path & "\*.*")
Do While ClientFile <> ""
If InStr(ClientFile, FilNmeStr) > 0 Then
AttachFile = Path & "\" & ClientFile
MailBody = "Hi " & FirstName & "," & vbNewLine & vbNewLine _
End If
ClientFile = Dir
Loop
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.SentOnBehalfOfName = """TechSupport"" <TechSupport#anycompany.com>"
.To = ToName
.cc = ccTo
.Subject = SL & " - " & cell.Offset(0, -9).Value
.Body = MailBody
.Attachments.Add (AttachFile)
.Display
'.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
RecpList = ""
End If
Next
End Sub

Answer 1

Try it this way.
Make a list in Sheets("Sheet1") with :
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