Try this (change thye sheet name)

Sub Send_Files()
'Working in 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range
Dim Num1 As Long
Dim Num2 As Long

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

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConst ants)

If Dir(cell.Value) < "" Then

Num1 = InStrRev(cell.Value, "\", , 1)
Num2 = InStrRev(cell.Value, ".", , 1)

Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = Mid(cell.Value, Num1 + 1, Num2 - Num1 - 1)
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value

If Dir(cell.Value) < "" Then
.Attachments.Add cell.Value
End If

If Application.WorksheetFunction.CountA(sh.Columns("E ")) 0 Then
For Each FileCell In sh.Columns("E").SpecialCells(xlCellTypeConstants)
If Trim(FileCell) < "" Then
If Dir(FileCell.Value) < "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
End If

.Display 'Or use Send
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"K" wrote in message ...
Thanks lot Ron i'll wait for you reply