Search code examples
excelvbaoutlook

Send emails with multiple files from one cell


I have multiple filepaths in a cell separated with commas that I need to send by email to respective recipients.
enter image description here

My code generates

Runtime Error '-2147024773 (8007007b, Filename or directory is not valid.

However, when I put a single file in a cell, that works:

Sub Preview()

Dim SendTo As String
Dim ToMSg As String
Dim Attachment As Variant
Dim Subj As String
Dim Item As Variant

i = 2

Do

    SendTo = ThisWorkbook.Sheets(1).Cells(i, "F")
    ToMSg = ThisWorkbook.Sheets(1).Cells(i, "I")
    Attachment = Split(ThisWorkbook.Sheets(1).Cells(i, "J").Value, ",")
    Subj = ThisWorkbook.Sheets(1).Cells(i, "H")
    Dim OutlookApp As Object
    Dim OutlookMail As Object

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)

    With OutlookMail
        .To = SendTo
        .CC = ""
        .BCC = ""
        .Subject = Subj
        .body = ToMSg
        For Each Item In Attachment
            .Attachments.Add Item
        Next
        .display
    End With
   
    Set OutMail = Nothing
    Set OutApp = Nothing

    Application.DisplayAlerts = True

    i = i + 1

Loop Until Cells(i, "A").Value = ""

End Sub

Solution

  • Possibly there are newline characters in the cells, in addition to the comma. Try

    Attachment = Split(Replace(ThisWorkbook.Sheets(1).Cells(i, "J").Value, vbLf, ""), ",")

    to remove any newlines, and

    .Attachments.Add Trim(Item)

    to take care of leading/trailing spaces.

    You could also use Dir(Item) to check whether the file exists before trying to add it.