Hi
Try this one
Sub TestFile1()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range, FileCell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _
.SpecialCells(xlCellTypeConstants)
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
Next FileCell
.Display 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl
<[email protected]> wrote in message news:[email protected]...
> Hello
> I've found this macro on a great website
> http://www.rondebruin.nl/mail/folder2/files.htm
>
> --------------------------------------------
>
> Make a list in Sheet("Sheet1") with
> In column A : Names of the people
> In column B : E-mail addresses
> In column C : 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
> and a filename that exist in that row it will create a mail with this
> information and send it.
>
>
> Sub TestFile()
> Dim OutApp As Outlook.Application
> Dim OutMail As Outlook.MailItem
> Dim cell As Range
>
> Application.ScreenUpdating = False
> Set OutApp = CreateObject("Outlook.Application")
>
> On Error GoTo cleanup
> For Each cell In
> Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
> If cell.Offset(0, 1).Value <> "" Then
> If cell.Value Like "?*@?*.?*" And Dir(cell.Offset(0,
> 1).Value) <> "" Then
> Set OutMail = OutApp.CreateItem(olMailItem)
> With OutMail
> .To = cell.Value
> .Subject = "Testfile"
> .Body = "Hi " & cell.Offset(0, -1).Value
> .Attachments.Add cell.Offset(0, 1).Value
> .Display 'Or use Display
> End With
> Set OutMail = Nothing
> End If
> End If
> Next cell
> cleanup:
> Set OutApp = Nothing
> Application.ScreenUpdating = True
> End Sub
>
> --------------------------------------------------
>
> but there is one problem for me i would like to send few files to one
> person not only one file. How should I change the macro to do this.
> File names will be in column C,D,E,F.
> Thank you for solving my problem.
>
> Kind Regards
> Wano
>
Bookmarks