Mail a different files to each person in a range

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
>

I update the site with a new macro
Please test it and post back if it is working OK for you

http://www.rondebruin.nl/mail/folder2/files.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" <[email protected]> wrote in message news:%[email protected]...
> 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
>>
>
>

Hi

I made a small change to avoid that the macro stop when there is one row without a file name

Sub TestFile()
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.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _
Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1")) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value

'Enter the file names in the C:F column in each row
'You can make the range bigger if you want, only change the column not the 1
For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _
.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
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" <[email protected]> wrote in message news:[email protected]...
>I update the site with a new macro
> Please test it and post back if it is working OK for you
>
> http://www.rondebruin.nl/mail/folder2/files.htm
>
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Ron de Bruin" <[email protected]> wrote in message news:%[email protected]...
>> 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
>>>
>>
>>
>
>

Ron de Bruin napisal(a):
> Hi
>
> I made a small change to avoid that the macro stop when there is one row without a file name
> .....
> Sub TestFile()
> .....
> End Sub
>
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>


Hi
Works PERFECT.
You're genius. Now I save some time and few mistakes.
Thank you. You helped me a lot.

Wano

You are welcome

Thanks for the feedback



--
Regards Ron de Bruin
http://www.rondebruin.nl


<[email protected]> wrote in message news:[email protected]...
>
> Ron de Bruin napisal(a):
>> Hi
>>
>> I made a small change to avoid that the macro stop when there is one row without a file name
>> .....
>> Sub TestFile()
>> .....
>> End Sub
>>
>>
>>
>> --
>> Regards Ron de Bruin
>> http://www.rondebruin.nl
>>
>
>
> Hi
> Works PERFECT.
> You're genius. Now I save some time and few mistakes.
> Thank you. You helped me a lot.
>
> Wano
>

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

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
>

I update the site with a new macro
Please test it and post back if it is working OK for you

http://www.rondebruin.nl/mail/folder2/files.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" <[email protected]> wrote in message news:%[email protected]...
> 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
>>
>
>

Hi

I made a small change to avoid that the macro stop when there is one row without a file name

Sub TestFile()
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.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA( _
Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1")) > 0 Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value

'Enter the file names in the C:F column in each row
'You can make the range bigger if you want, only change the column not the 1
For Each FileCell In Sheets("Sheet1").Cells(cell.Row, 1).Range("C1:F1") _
.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
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" <[email protected]> wrote in message news:[email protected]...
>I update the site with a new macro
> Please test it and post back if it is working OK for you
>
> http://www.rondebruin.nl/mail/folder2/files.htm
>
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Ron de Bruin" <[email protected]> wrote in message news:%[email protected]...
>> 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
>>>
>>
>>
>
>

Ron de Bruin napisal(a):
> Hi
>
> I made a small change to avoid that the macro stop when there is one row without a file name
> .....
> Sub TestFile()
> .....
> End Sub
>
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>


Hi
Works PERFECT.
You're genius. Now I save some time and few mistakes.
Thank you. You helped me a lot.

Wano

You are welcome

Thanks for the feedback



--
Regards Ron de Bruin
http://www.rondebruin.nl


<[email protected]> wrote in message news:[email protected]...
>
> Ron de Bruin napisal(a):
>> Hi
>>
>> I made a small change to avoid that the macro stop when there is one row without a file name
>> .....
>> Sub TestFile()
>> .....
>> End Sub
>>
>>
>>
>> --
>> Regards Ron de Bruin
>> http://www.rondebruin.nl
>>
>
>
> Hi
> Works PERFECT.
> You're genius. Now I save some time and few mistakes.
> Thank you. You helped me a lot.
>
> Wano
>