Mail a different file(s) to each person in a range

[djar]

Hello,

I needed to mail files to people in a ranges. I am using the following code.

This works perfect when the filenames are STRINGS, but if the filenames come from a formula ( in order to add the directory, extention, etc), the email is created but without the attachments.

If someone can look into this, it would be greatly appreciated!

Regards

D

this code originally found here:
http://www.rondebruin.nl/mail/folder2/files.htm

-----------------------------------

Make a list in Sheets("Sheet1") with :

In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range

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

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

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

'Enter the file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

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

With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).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

.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
-----------------------