Add email attachment(s) from excel to outlook based on condition - excel

Question

I have a list of names, email, attachment name and I need to send email and attach these attachment, my macro worked if I specify number of attachment, but what I have is not a fix number of attachments for each name/email, sometimes it's one and sometimes more than 1. Can you check my macro and advise what should I change/add in order to make the attachment dynamic?
Sub CreateNewMessage()
Dim aOutlook As Object
Dim aEmail As Object
Dim obj As Object
Dim olInsp As Object
Dim myDoc As Object
Dim oRng As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
Dim ToCc As Range, strBody, strSig As String
Dim fColorBlue, fColorGreen, fColorRed, fDukeBlue1, fDukeBlue2, fAggieMaroon, fAggieGray As String
Dim Greeting, emailContent As String
Dim emailOpen, emailMid1, emailMid2, emailMid3, emailClose, emailCustom, emailSig As String
Dim AttachmentPath, AttachmentNm As String
AttachmentPath = [O1] & "\"
fColorBlue = "#003846"
fColorGreen = "#5e9732"
fColorRed = "#FF0000"
fDukeBlue1 = "#001A57"
fDukeBlue2 = "#00009C"
fAggieMaroon = "#500000"
fAggieGray = "#332C2C"
For Each ToCc In ActiveSheet.[A2:A100] 'This is the range for how many records (rows) you want to send email
'=============================================================
Dim ToEmail, CcEmail, ToNm, CcNm, CcLNm As String
Dim DescrDt, LocID, LsmID, DescrNm As String
Dim Attach1, Attach2, Attach3 As String
ToNm = Cells(ToCc.Row, [To___fName].Column).Value
CcNm = Cells(ToCc.Row, [Cc___fName].Column).Value
CcLNm = Cells(ToCc.Row, [Cc___LName].Column).Value
ToEmail = Cells(ToCc.Row, [To___Email].Column).Value
CcEmail = Cells(ToCc.Row, [Cc___Email].Column).Value
Attach1 = Cells(ToCc.Row, [Attachment1].Column).Value
Attach2 = Cells(ToCc.Row, [Attachment2].Column).Value
Attach3 = Cells(ToCc.Row, [Attachment3].Column).Value
AttachmentNm1 = Attach1
AttachmentNm2 = Attach2
AttachmentNm3 = Attach3
Dim FileAttach1 As String
Dim FileAttach2 As String
Dim FileAttach3 As String
FileAttach1 = AttachmentPath & AttachmentNm1
FileAttach2 = AttachmentPath & AttachmentNm2
FileAttach3 = AttachmentPath & AttachmentNm3
'MsgBox FileAttach1
'MsgBox FileAttach2
'MsgBox FileAttach3
'Exit Sub
'=============================================================
Set aEmail = aOutlook.CreateItem(0)
With aEmail
'.SentOnBehalfOfName = "name#company.com"
.SentOnBehalfOfName = "name2#company.com"
.To = ToEmail
.cc = CcEmail '& "; " & SupvEmail & "; " & HREmail
.Subject = "LSM Monthly Dashboard " & Application.WorksheetFunction.Proper(ToNm) & Chr(32) & Application.WorksheetFunction.Proper(DescrNm)
'.BodyFormat = olFormatPlain ' send plain text message
'.BodyFormat = olFormatHTML
'.Importance = olImportanceHigh
'.Sensitivity = olConfidential
.HTMLBody = emailContent
'MsgBox FileAttach1
.Attachments.Add FileAttach1
.Attachments.Add FileAttach2
.Attachments.Add FileAttach3
.display
' .send
End With
NEXT_ToCC:
Set aEmail = Nothing
Set olInsp = Nothing
Set myDoc = Nothing
Set oRng = Nothing
Next ToCc
End Sub

Answer 1

You should use array to do this.
Add files paths to an array.
Dim files()
Files = array(path1, path2)
And after ‚htmlbody’ write:
For i = lbound(files) to ubound(files)
.attachments.add files(i)
Next i