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
 
     
    