Body of email to include names of attached files

Hi all, im having difficulty on adding the names of the attached files into the body of an email created by the following code.
It attaches files without any problems on Excel 2003 onwards but want to include into the body of the email the filenames of files attached.

Contract = Sheets("Prefs").Range("Y5").Value
Set Sh = Sheets("Quick Search")
Set OutApp = CreateObject("Outlook.Application")
Set rng = Sh.Range("AQ4:AQ33")
Set Rn = Workbooks("Speedmail.xls").Worksheets("Local").Range("W1")
If Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Subject = Contract
.body = "Hello," & vbLf & vbLf & "Please find attached your documents." & vbLf & "Many thanks" & vbLf & vbLf & Application.UserName
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.attachments.Add FileCell.Value
With Workbooks("Drawing Register.xls").Worksheets("Local")
.Range("A" & FileCell.Offset(0, -20) + 2 & ":T" & FileCell.Offset(0, -20) + 2).Copy Workbooks("Speedmail.xls").Worksheets("Local").Range("A" & Rn)
End With
Rn = Rn + 1
End If
End If
Next FileCell
Workbooks("Speedmail.xls").Close SaveChanges:=True
.attachments.Add ThisWorkbook.Path & "\" & "Speedmail.xls"
.display
End With
Set OutMail = Nothing
End If
Set OutApp = Nothing

It takes its list of files to attach from an array say 20 files including their paths and produces an email with all the files attached.
As well as the message produced by the Body part in the code, Im unsure how to make it add each filename into the body when it loops to add the files.

Any help is much appreciated.

To all who's been looking to attach files to an email and want to include into the body of the email the filenames of all attached files, I managed to solve my own question as I could not locate anywhere on the web on how to do it.

Contract = Sheets("Prefs").Range("Y5").Value
Set Sh = Sheets("Quick Search")
Set OutApp = CreateObject("Outlook.Application")
Set rng = Sh.Range("AQ4:AQ33")
Set Rn = Workbooks("Speedmail.xls").Worksheets("Local").Range("W1")
If Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.createitem(0)
With OutMail
.Subject = Contract
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
With Workbooks("Drawing Register.xls").Worksheets("Local")
.Range("A" & FileCell.Offset(0, -20) + 2 & ":T" & FileCell.Offset(0, -20) + 2).Copy Workbooks("Speedmail.xls").Worksheets("Local").Range("A" & Rn)
End With
strbody = strbody & vbNewLine & FileCell.Offset(0, 3)
Rn = Rn + 1
End If
End If
Next FileCell
Workbooks("Speedmail.xls").Close SaveChanges:=True
.Attachments.Add ThisWorkbook.Path & "\" & "Speedmail.xls"
.body = "Hi," & vbNewLine & vbNewLine & "Add your email greeting here." & vbNewLine & strbody & vbNewLine & vbNewLine & "Kind regards" & vbNewLine & vbNewLine & Application.UserName
.display
End With

Set OutMail = Nothing
End If
Set OutApp = Nothing

The items in bold are the items modified between both posts of this query.

Enjoy

Hi everybody, the below is the code I am now using which works without error - It adds files to an email and lists each file in turn and allows you to format any text you would like to add in the body of the email, I could not find all of this in 1 piece of code so am happy to share on Excel Forum the only place it deserves to be.

Option Explicit
Option Private Module

Sub Email_Files()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim Sh As Worksheet
    Dim FileCell As Range
    Dim Contract
    Dim strbody As String

'In Al:A50 write full path name including filename of each file ie: C:\Book1.pdf
'In B1 write what you want the filenames to appear as in the email ie: Book1.pdf
'In C1 write what you want the email subject line to be

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

With Worksheets("Sheet1").Range("A1:A50") '< This worksheet column range must be non-formula results and is full path inc filename and extension
.Copy
.PasteSpecial xlPasteValues '< This makes the formula's text results if they are formula results
End With

Contract = Sheets("Sheet1").Range("C1").Value '< This is the Email subject line

Set Sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
Set rng = Sh.Range("A1:A50")
If Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.createitem(0)
With OutMail
.Subject = Contract
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
strbody = strbody & "<br>" & "<font color=""blue"">" & FileCell.Offset(0, 1) & "<font color=""darkred"">" '< In cell "C1" add the filename text
End If
End If
Next FileCell
.HTMLbody = "<font face=""Calibri"" size=""11pt"" color=""darkred"">" & "Hi," & "<br>" & "<br>" & "Here are your files." & "<br>" & strbody & "<br>" & "<br>" & "Kind regards" & "<br>" & "<br>" & Application.UserName & "<br>" & "<br>" & "You can add a weblink too" & "<br>" & "Which is available here: " & "<font color=""blue"">" & "<a href=""http://alanwelsman.co.uk/Drawing%20Register.xls"">Drawing Register.xls</a>" & "<font color=""darkred"">" & "<br>" & "The easiest way to Sort & Send your documents."
.display
End With

Set OutMail = Nothing
End If
Set OutApp = Nothing

With Worksheets("Sheet1")
.Range("A1").Formula = ""
.Range("A1").Copy Range("A2:A50") '< Re-applies the formulas
End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Application.Calculation = xlCalculationAutomatic

End Sub

Copy into a module within a new excel file, add the 3 pieces of info and enjoy.