Add multiple attachments from email list

[The Ruff Report]

This should be easy but it's driving me nuts. I'm not great with VBA with Outlook. This references the file name to be attached (J1):

AttachFileName = Path & cell.Offset(0, 8).Value

All I want to do is attach up to 3 attachments if the cell isn't null (J1, K1, L1).

Any help is appreciated as usual
-------------------------------------------------------------------------------------

Sub Mail()
'
' Mail Macro

Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim strbody As String
Dim MailBody As String
Dim cell As Range


Path = "C:\Users\bobb\Desktop\Macros\Reports\"
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))

For Each cell In Rng
Rw = cell.Row
If cell.Value <> "" Then
EmailSendTo = cell.Offset(0, 0) & ";" & cell.Offset(0, 1) & ";" & cell.Offset(0, 2) & ";" & cell.Offset(0, 3) & ";" & cell.Offset(0, 4) & ";" & cell.Offset(0, 5) & ";" & cell.Offset(0, 6) & ";" & cell.Offset(0, 7)
AttachFileName = Path & cell.Offset(0, 8).Value

'Email Subject
EmailSubject = "This is a Mail Test - Delete Email"

'Mail Body string

strbody = "Good Morning," & vbNewLine & vbNewLine & _
"Attached are 12 2023 chargebacks. Please reach out if you have any questions." & vbNewLine & _
"Thanks," & vbNewLine & _
"Bob"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Subject = EmailSubject
.to = EmailSendTo
.SentOnBehalfOfName = "bob@mycompany.com"
.Body = strbody
.Attachments.Add (AttachFileName)
.Display

End With

Set OutMail = Nothing
Set OutApp = Nothing
strbody = ""

End If
Next

End Sub

 

[Trebor76]

Hi there,

Untested but try this (I think you need to loop through each file you want to attach to the email):

Option Explicit
Sub Mail()

    Dim OutApp As Object, OutMail As Object
    Dim EmailSubject As String, EmailSendTo As String, strbody As String, MailBody As String, Path As String
    Dim cell As Range, Rng As Range
    Dim Rw As Long
    Dim intColOffset As Integer
    
    Path = "C:\Users\bobb\Desktop\Macros\Reports\"
    Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    
    For Each cell In Rng
        Rw = cell.Row
        If cell.Value <> "" Then
            EmailSendTo = cell.Offset(0, 0) & ";" & cell.Offset(0, 1) & ";" & cell.Offset(0, 2) & ";" & cell.Offset(0, 3) & ";" & cell.Offset(0, 4) & ";" & cell.Offset(0, 5) & ";" & cell.Offset(0, 6) & ";" & cell.Offset(0, 7)
            'AttachFileName = Path & cell.Offset(0, 8).Value
            
            'Email Subject
            EmailSubject = "This is a Mail Test - Delete Email"
            
            'Mail Body string
            
            strbody = "Good Morning," & vbNewLine & vbNewLine & _
            "Attached are 12 2023 chargebacks. Please reach out if you have any questions." & vbNewLine & _
            "Thanks," & vbNewLine & _
            "Bob"
            
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
            .Subject = EmailSubject
            .To = EmailSendTo
            .SentOnBehalfOfName = "bob@mycompany.com"
            .Body = strbody
            For intColOffset = 8 To 10 'Offset columns from Col. B i.e. J, K and L
                If Len(cell.Offset(0, intColOffset).Value) > 0 Then
                    .Attachments.Add CStr(Path & cell.Offset(0, intColOffset).Value)
                End If
            Next intColOffset
            .Display
            
            End With
            
            Set OutMail = Nothing
            Set OutApp = Nothing
            strbody = ""
        
        End If
    Next cell

End Sub

Regards,

Robert