Excel Email vba w/ attachment w/ signature not working.

Hi!

I managed to make this work when I didn't add the signature but now it only sends an email with the body without the signature or the attachments.

So I've tried to write code so that I can send emails automatically with pretty much the same body but personalized attachments. It's really important I add the signature with the htm file as it contains links, a logo and a lot of legal text.

This is how my sheet is organised:
Column A is name of recipient
Column B is their email address
And attachments are from column M onwards.


Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim StrSignature As String
Dim sPath As String


With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Send")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'path/file names in the M:Z column in each row

Set rng = sh.Cells(cell.Row, 1).Range("M1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)


sPath = Environ("appdata") & "\signature.rtf"
If Dir(sPath) <> "" Then
StrSignature = GetBoiler(sPath)
Else
StrSignature = ""
End If
On Error Resume Next

With OutMail
.to = cell.Value
.Subject = "Monthly Update"
.Body = "Good Morning " & cell.Offset(0, -1).Value & "," & vbNewLine & vbNewLine & _
"Please find attached " & vbNewLine & vbNewLine & StrSignature

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send 'Or use .Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


Can someone help me debug this please???

Sub Send_Files()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim StrSignature As String
    Dim sPath As String
    
           
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Send")

    Set OutApp = CreateObject("Outlook.Application")
                 
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'path/file names in the M:Z column in each row
    
        Set rng = sh.Cells(cell.Row, 1).Range("M1:Z1")
             
        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)


        sPath = Environ("appdata") & "\Stephsignature.rtf"
                If Dir(sPath) <> "" Then
                StrSignature = GetBoiler(sPath)
                Else
                StrSignature = ""
                End If
        On Error Resume Next
       
            With OutMail
                .to = cell.Value
                .Subject = "Monthly Update"
                .Body = "Good Morning " & cell.Offset(0, -1).Value & "," & vbNewLine & vbNewLine & _
                "Please find attached " & vbNewLine & vbNewLine & StrSignature
                
                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send 'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Sorry about that