Unable To Attach File To Outlook Email with VBA

[AJZMR]

I am trying to attach a XLS to each email - I have attached the file I am working with. Each file has the same name column "A". The Email is displaying fine but the file itself is not attaching I i'm not sure what I am doing wrong. The Files are stored in the folder in column "E".

Any help?

Below is the code I am using.

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

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

    Set sh = Sheets("Techs")

    Set OutApp = CreateObject("Outlook.Application")

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

     
        Set rng = sh.Cells(cell.Row, 1).Range("e2:Z2")

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

            With OutMail
                .to = cell.Value
                .Subject = ThisWorkbook.Sheets("Techs").Range("C2").Value
                .Body = ThisWorkbook.Sheets("Techs").Range("d2").Value

                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

                .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

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

[Excel Fox]

This should help.. it's almost the same layout as your file, so you shouldn't find it difficult to edit.

http://www.excelfox.com/forum/f18/se...email-ids-304/