VBA: Send Outlook Email & Attach PDF

[larinda4]

Hi Excel Community,

Below is a screenshot of the structure of my Excel file.

Each row is a separate email and the location of the file is in column E and there will only ever be one attachment.

I took this code from another thread and tried modifying it as it pulled ALL the PDFs from the file folder where as I already have the filepath of the attachment.

Here is my code:

Sub SendMail()

    ActiveWorkbook.RefreshAll
    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim ws As Worksheet
    Dim fileName As String
    Dim cell As Range
    

    Set objOutlook = CreateObject("Outlook.Application")
    Set ws = ActiveSheet
    
  For Each cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))


    Set objMail = objOutlook.CreateItem(0)


        With objMail
            .To = cell.Value
            .Subject = cell.Offset(0, 2).Value
            .CC = cell.Offset(0, 1).Value
            .Body = cell.Offset(0, 3).Value
            fileName = Dir(cell.Offset(0, 4).Value)
                        While fileName <> vbNullString
                            .Attachments.Add cell.Offset(0, 4).Value
                            fileName = Dir()
                        Wend
            .Display
        End With

        Set objMail = Nothing
    Next cell

    Set ws = Nothing
    Set objOutlook = Nothing

End Sub

Any help would be appreciated.

 

[Trebor76]

Hi larinda4,

Untested but I think you just need to remove or comment out this block...

Filename = Dir(cell.Offset(0, 4).Value)
        While Filename <> vbNullString
            .Attachments.Add cell.Offset(0, 4).Value
            Filename = Dir()
        Wend

...and use this:

 .Attachments.Add cell.Offset(0, 4).Value

Hope that helps,

Robert