Hi All,

Background:
One base workbook creates separate workbooks with appropriate data
for each team, then displays each of the teams emails (12) ready to
send. At this stage I manually include people to cc the email to (this
varies between the 12 emails) then send.

Outcome:
I would like to automate this process if I could.

Detail:
I have the following email code (thanks to Ron DeBruin) in the base
workbook, but would like to add one or more cc's to it as well.

Not sure if this is possible but would appreciate any assistance
please?

Regards

Bob


Sub Send_Files2()

' Loops through email addresses, attaches appropriate TL file to new
email, then sends.
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range


Sheets("Sheet15").Select
Sheets("Sheet15").Select
Columns("C:C").Select
Selection.ClearContents
Columns("G:G").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

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


Set sh = Sheets("Sheet15")



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



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



'Enter the file names in the C:Z column in each row if
multiple files to attach
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 = "Subject - " & cell.Offset(0, 4).Value
.Body = " Hi " & cell.Offset(0, 3).Value & "," &
vbNewLine & vbNewLine & _
" The attached file details your team's
statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
" Regards,"

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

.Display 'Or use Send
'.Send
End With



Set OutMail = Nothing
End If
Next cell



Set OutApp = Nothing


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

Sheets("Main").Select
End Sub

See
http://www.rondebruin.nl/mail/tips2.htm

Are your mail addresses also in the table ?


--

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


"Ozbobeee" <(E-Mail Removed)> wrote in message news:17b80472-532d-4440-a38c-(E-Mail Removed)...
> Hi All,
>
> Background:
> One base workbook creates separate workbooks with appropriate data
> for each team, then displays each of the teams emails (12) ready to
> send. At this stage I manually include people to cc the email to (this
> varies between the 12 emails) then send.
>
> Outcome:
> I would like to automate this process if I could.
>
> Detail:
> I have the following email code (thanks to Ron DeBruin) in the base
> workbook, but would like to add one or more cc's to it as well.
>
> Not sure if this is possible but would appreciate any assistance
> please?
>
> Regards
>
> Bob
>
>
> Sub Send_Files2()
>
> ' Loops through email addresses, attaches appropriate TL file to new
> email, then sends.
> Dim OutApp As Object
> Dim OutMail As Object
> Dim sh As Worksheet
> Dim cell As Range, FileCell As Range, rng As Range
>
>
> Sheets("Sheet15").Select
> Sheets("Sheet15").Select
> Columns("C:C").Select
> Selection.ClearContents
> Columns("G:G").Select
> Selection.Copy
> Range("C1").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> Application.CutCopyMode = False
> Range("A1").Select
>
> With Application
> .EnableEvents = False
> .ScreenUpdating = False
> End With
>
>
> Set sh = Sheets("Sheet15")
>
>
>
> Set OutApp = CreateObject("Outlook.Application")
> OutApp.Session.Logon
>
>
>
> For Each cell In
> sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>
>
>
> 'Enter the file names in the C:Z column in each row if
> multiple files to attach
> 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 = "Subject - " & cell.Offset(0, 4).Value
> .Body = " Hi " & cell.Offset(0, 3).Value & "," &
> vbNewLine & vbNewLine & _
> " The attached file details your team's
> statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
> " Regards,"
>
> 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
>
> .Display 'Or use Send
> '.Send
> End With
>
>
>
> Set OutMail = Nothing
> End If
> Next cell
>
>
>
> Set OutApp = Nothing
>
>
> With Application
> .EnableEvents = True
> .ScreenUpdating = True
> End With
>
> Sheets("Main").Select
> End Sub
>
>

Hi,
The code displayed at this link includes cc
http://www.tanguay.info/web/codeExample.php?id=904

Hi Ron,

Yes they are.

Cheers

Bob


On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Seehttp://www.rondebruin.nl/mail/tips2.htm
>
> Are your mail addresses also in the table ?
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
> > Hi All,
>
> > Background:
> > One base workbook creates separate workbooks with appropriate data
> > for each team, then displays each of the teams emails (12) ready to
> > send. At this stage I manually include people to cc the email to (this
> > varies between the 12 emails) then send.
>
> > Outcome:
> > I would like to automate this process if I could.
>
> > Detail:
> > I have the following email code (thanks to Ron DeBruin) in the base
> > workbook, but would like to add one or more cc's to it as well.
>
> > Not sure if this is possible but would appreciate any assistance
> > please?
>
> > Regards
>
> > Bob
>
> > Sub Send_Files2()
>
> > ' Loops through email addresses, attaches appropriate TL file to new
> > email, then sends.
> > Dim OutApp As Object
> > Dim OutMail As Object
> > Dim sh As Worksheet
> > Dim cell As Range, FileCell As Range, rng As Range
>
> > Sheets("Sheet15").Select
> > Sheets("Sheet15").Select
> > Columns("C:C").Select
> > Selection.ClearContents
> > Columns("G:G").Select
> > Selection.Copy
> > Range("C1").Select
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _
> > :=False, Transpose:=False
> > Application.CutCopyMode = False
> > Range("A1").Select
>
> > With Application
> > .EnableEvents = False
> > .ScreenUpdating = False
> > End With
>
> > Set sh = Sheets("Sheet15")
>
> > Set OutApp = CreateObject("Outlook.Application")
> > OutApp.Session.Logon
>
> > For Each cell In
> > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>
> > 'Enter the file names in the C:Z column in each row if
> > multiple files to attach
> > 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 = "Subject - " & cell.Offset(0, 4).Value
> > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
> > vbNewLine & vbNewLine & _
> > " The attached file details your team's
> > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
> > " Regards,"
>
> > 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
>
> > .Display 'Or use Send
> > '.Send
> > End With
>
> > Set OutMail = Nothing
> > End If
> > Next cell
>
> > Set OutApp = Nothing
>
> > With Application
> > .EnableEvents = True
> > .ScreenUpdating = True
> > End With
>
> > Sheets("Main").Select
> > End Sub

Hi Ron,

After I sent my initial email, I tested with additional email
addresses in the table I use. The result was of course a fresh email
for every address.

What I would like to do though is have a core number of "To" email
addressses and a dynamic list of "cc" addresses if that is possible.

Cheers

Bob


On Jun 8, 5:03 am, Ozbobeee <ozbob...@gmail.com> wrote:
> Hi Ron,
>
> Yes they are.
>
> Cheers
>
> Bob
>
> On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>
> > Seehttp://www.rondebruin.nl/mail/tips2.htm
>
> > Are your mail addresses also in the table ?
>
> > --
>
> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
> > > Hi All,
>
> > > Background:
> > > One base workbook creates separate workbooks with appropriate data
> > > for each team, then displays each of the teams emails (12) ready to
> > > send. At this stage I manually include people to cc the email to (this
> > > varies between the 12 emails) then send.
>
> > > Outcome:
> > > I would like to automate this process if I could.
>
> > > Detail:
> > > I have the following email code (thanks to Ron DeBruin) in the base
> > > workbook, but would like to add one or more cc's to it as well.
>
> > > Not sure if this is possible but would appreciate any assistance
> > > please?
>
> > > Regards
>
> > > Bob
>
> > > Sub Send_Files2()
>
> > > ' Loops through email addresses, attaches appropriate TL file to new
> > > email, then sends.
> > > Dim OutApp As Object
> > > Dim OutMail As Object
> > > Dim sh As Worksheet
> > > Dim cell As Range, FileCell As Range, rng As Range
>
> > > Sheets("Sheet15").Select
> > > Sheets("Sheet15").Select
> > > Columns("C:C").Select
> > > Selection.ClearContents
> > > Columns("G:G").Select
> > > Selection.Copy
> > > Range("C1").Select
> > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > > SkipBlanks _
> > > :=False, Transpose:=False
> > > Application.CutCopyMode = False
> > > Range("A1").Select
>
> > > With Application
> > > .EnableEvents = False
> > > .ScreenUpdating = False
> > > End With
>
> > > Set sh = Sheets("Sheet15")
>
> > > Set OutApp = CreateObject("Outlook.Application")
> > > OutApp.Session.Logon
>
> > > For Each cell In
> > > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>
> > > 'Enter the file names in the C:Z column in each row if
> > > multiple files to attach
> > > 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 = "Subject - " & cell.Offset(0, 4).Value
> > > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
> > > vbNewLine & vbNewLine & _
> > > " The attached file details your team's
> > > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
> > > " Regards,"
>
> > > 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
>
> > > .Display 'Or use Send
> > > '.Send
> > > End With
>
> > > Set OutMail = Nothing
> > > End If
> > > Next cell
>
> > > Set OutApp = Nothing
>
> > > With Application
> > > .EnableEvents = True
> > > .ScreenUpdating = True
> > > End With
>
> > > Sheets("Main").Select
> > > End Sub

Good morning

Try this

See this two lines

'Enter the file names in the C:K column in each row
'Enter the CC addresses in the L:P column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")


Sub Send_Files_test()
'Working in 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range
Dim rng As Range, rng2 As Range
Dim CCcell As Range
Dim strCC As String

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("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the file names in the C:K column in each row
'Enter the CC addresses in the L:P column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")

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

With OutMail
.To = cell.Value

For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
If CCcell.Value Like "?*@?*.?*" Then
strCC = strCC & CCcell.Value & ";"
End If
Next CCcell
If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)

.CC = strCC
.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
.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


"Ozbobeee" <(E-Mail Removed)> wrote in message news:b2560163-04c7-4a3d-bafe-(E-Mail Removed)...
> Hi Ron,
>
> After I sent my initial email, I tested with additional email
> addresses in the table I use. The result was of course a fresh email
> for every address.
>
> What I would like to do though is have a core number of "To" email
> addressses and a dynamic list of "cc" addresses if that is possible.
>
> Cheers
>
> Bob
>
>
> On Jun 8, 5:03 am, Ozbobeee <ozbob...@gmail.com> wrote:
>> Hi Ron,
>>
>> Yes they are.
>>
>> Cheers
>>
>> Bob
>>
>> On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>>
>> > Seehttp://www.rondebruin.nl/mail/tips2.htm
>>
>> > Are your mail addresses also in the table ?
>>
>> > --
>>
>> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>>
>> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
>> > > Hi All,
>>
>> > > Background:
>> > > One base workbook creates separate workbooks with appropriate data
>> > > for each team, then displays each of the teams emails (12) ready to
>> > > send. At this stage I manually include people to cc the email to (this
>> > > varies between the 12 emails) then send.
>>
>> > > Outcome:
>> > > I would like to automate this process if I could.
>>
>> > > Detail:
>> > > I have the following email code (thanks to Ron DeBruin) in the base
>> > > workbook, but would like to add one or more cc's to it as well.
>>
>> > > Not sure if this is possible but would appreciate any assistance
>> > > please?
>>
>> > > Regards
>>
>> > > Bob
>>
>> > > Sub Send_Files2()
>>
>> > > ' Loops through email addresses, attaches appropriate TL file to new
>> > > email, then sends.
>> > > Dim OutApp As Object
>> > > Dim OutMail As Object
>> > > Dim sh As Worksheet
>> > > Dim cell As Range, FileCell As Range, rng As Range
>>
>> > > Sheets("Sheet15").Select
>> > > Sheets("Sheet15").Select
>> > > Columns("C:C").Select
>> > > Selection.ClearContents
>> > > Columns("G:G").Select
>> > > Selection.Copy
>> > > Range("C1").Select
>> > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
>> > > SkipBlanks _
>> > > :=False, Transpose:=False
>> > > Application.CutCopyMode = False
>> > > Range("A1").Select
>>
>> > > With Application
>> > > .EnableEvents = False
>> > > .ScreenUpdating = False
>> > > End With
>>
>> > > Set sh = Sheets("Sheet15")
>>
>> > > Set OutApp = CreateObject("Outlook.Application")
>> > > OutApp.Session.Logon
>>
>> > > For Each cell In
>> > > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>>
>> > > 'Enter the file names in the C:Z column in each row if
>> > > multiple files to attach
>> > > 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 = "Subject - " & cell.Offset(0, 4).Value
>> > > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
>> > > vbNewLine & vbNewLine & _
>> > > " The attached file details your team's
>> > > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
>> > > " Regards,"
>>
>> > > 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
>>
>> > > .Display 'Or use Send
>> > > '.Send
>> > > End With
>>
>> > > Set OutMail = Nothing
>> > > End If
>> > > Next cell
>>
>> > > Set OutApp = Nothing
>>
>> > > With Application
>> > > .EnableEvents = True
>> > > .ScreenUpdating = True
>> > > End With
>>
>> > > Sheets("Main").Select
>> > > End Sub
>

Oops

Use this one

Sub Send_Files_test()
'Working in 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range
Dim rng As Range, rng2 As Range
Dim CCcell As Range
Dim strCC As String

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("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the file names in the C:K column in each row
'Enter the CC addresses in the L:P column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")

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

With OutMail
.To = cell.Value

On Error Resume Next
For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
If CCcell.Value Like "?*@?*.?*" Then
strCC = strCC & CCcell.Value & ";"
End If
Next CCcell
If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
On Error GoTo 0

.CC = strCC
.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
.Display 'Or use Display
End With

Set OutMail = Nothing
End If
strCC = ""
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


"Ron de Bruin" <(E-Mail Removed)> wrote in message news:(E-Mail Removed)...
> Good morning
>
> Try this
>
> See this two lines
>
> 'Enter the file names in the C:K column in each row
> 'Enter the CC addresses in the L:P column in each row
> Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
> Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>
>
> Sub Send_Files_test()
> 'Working in 2000-2007
> Dim OutApp As Object
> Dim OutMail As Object
> Dim sh As Worksheet
> Dim cell As Range, FileCell As Range
> Dim rng As Range, rng2 As Range
> Dim CCcell As Range
> Dim strCC As String
>
> 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("B").Cells.SpecialCells(xlCellTypeConstants)
>
> 'Enter the file names in the C:K column in each row
> 'Enter the CC addresses in the L:P column in each row
> Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
> Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>
> If cell.Value Like "?*@?*.?*" And _
> Application.WorksheetFunction.CountA(rng) > 0 Then
> Set OutMail = OutApp.CreateItem(0)
>
> With OutMail
> .To = cell.Value
>
> For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
> If CCcell.Value Like "?*@?*.?*" Then
> strCC = strCC & CCcell.Value & ";"
> End If
> Next CCcell
> If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
>
> .CC = strCC
> .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
> .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
>
>
> "Ozbobeee" <(E-Mail Removed)> wrote in message news:b2560163-04c7-4a3d-bafe-(E-Mail Removed)...
>> Hi Ron,
>>
>> After I sent my initial email, I tested with additional email
>> addresses in the table I use. The result was of course a fresh email
>> for every address.
>>
>> What I would like to do though is have a core number of "To" email
>> addressses and a dynamic list of "cc" addresses if that is possible.
>>
>> Cheers
>>
>> Bob
>>
>>
>> On Jun 8, 5:03 am, Ozbobeee <ozbob...@gmail.com> wrote:
>>> Hi Ron,
>>>
>>> Yes they are.
>>>
>>> Cheers
>>>
>>> Bob
>>>
>>> On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>>>
>>> > Seehttp://www.rondebruin.nl/mail/tips2.htm
>>>
>>> > Are your mail addresses also in the table ?
>>>
>>> > --
>>>
>>> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>>>
>>> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
>>> > > Hi All,
>>>
>>> > > Background:
>>> > > One base workbook creates separate workbooks with appropriate data
>>> > > for each team, then displays each of the teams emails (12) ready to
>>> > > send. At this stage I manually include people to cc the email to (this
>>> > > varies between the 12 emails) then send.
>>>
>>> > > Outcome:
>>> > > I would like to automate this process if I could.
>>>
>>> > > Detail:
>>> > > I have the following email code (thanks to Ron DeBruin) in the base
>>> > > workbook, but would like to add one or more cc's to it as well.
>>>
>>> > > Not sure if this is possible but would appreciate any assistance
>>> > > please?
>>>
>>> > > Regards
>>>
>>> > > Bob
>>>
>>> > > Sub Send_Files2()
>>>
>>> > > ' Loops through email addresses, attaches appropriate TL file to new
>>> > > email, then sends.
>>> > > Dim OutApp As Object
>>> > > Dim OutMail As Object
>>> > > Dim sh As Worksheet
>>> > > Dim cell As Range, FileCell As Range, rng As Range
>>>
>>> > > Sheets("Sheet15").Select
>>> > > Sheets("Sheet15").Select
>>> > > Columns("C:C").Select
>>> > > Selection.ClearContents
>>> > > Columns("G:G").Select
>>> > > Selection.Copy
>>> > > Range("C1").Select
>>> > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
>>> > > SkipBlanks _
>>> > > :=False, Transpose:=False
>>> > > Application.CutCopyMode = False
>>> > > Range("A1").Select
>>>
>>> > > With Application
>>> > > .EnableEvents = False
>>> > > .ScreenUpdating = False
>>> > > End With
>>>
>>> > > Set sh = Sheets("Sheet15")
>>>
>>> > > Set OutApp = CreateObject("Outlook.Application")
>>> > > OutApp.Session.Logon
>>>
>>> > > For Each cell In
>>> > > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>>>
>>> > > 'Enter the file names in the C:Z column in each row if
>>> > > multiple files to attach
>>> > > 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 = "Subject - " & cell.Offset(0, 4).Value
>>> > > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
>>> > > vbNewLine & vbNewLine & _
>>> > > " The attached file details your team's
>>> > > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
>>> > > " Regards,"
>>>
>>> > > 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
>>>
>>> > > .Display 'Or use Send
>>> > > '.Send
>>> > > End With
>>>
>>> > > Set OutMail = Nothing
>>> > > End If
>>> > > Next cell
>>>
>>> > > Set OutApp = Nothing
>>>
>>> > > With Application
>>> > > .EnableEvents = True
>>> > > .ScreenUpdating = True
>>> > > End With
>>>
>>> > > Sheets("Main").Select
>>> > > End Sub
>>

On Jun 8, 8:00 pm, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Oops
>
> Use this one
>
> Sub Send_Files_test()
> 'Working in 2000-2007
> Dim OutApp As Object
> Dim OutMail As Object
> Dim sh As Worksheet
> Dim cell As Range, FileCell As Range
> Dim rng As Range, rng2 As Range
> Dim CCcell As Range
> Dim strCC As String
>
> 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("B").Cells.SpecialCells(xlCellTypeConstants)
>
> 'Enter the file names in the C:K column in each row
> 'Enter the CC addresses in the L:P column in each row
> Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
> Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>
> If cell.Value Like "?*@?*.?*" And _
> Application.WorksheetFunction.CountA(rng) > 0 Then
> Set OutMail = OutApp.CreateItem(0)
>
> With OutMail
> .To = cell.Value
>
> On Error Resume Next
> For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
> If CCcell.Value Like "?*@?*.?*" Then
> strCC = strCC & CCcell.Value & ";"
> End If
> Next CCcell
> If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
> On Error GoTo 0
>
> .CC = strCC
> .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
> .Display 'Or use Display
> End With
>
> Set OutMail = Nothing
> End If
> strCC = ""
> Next cell
>
> Set OutApp = Nothing
>
> With Application
> .EnableEvents = True
> .ScreenUpdating = True
> End With
> End Sub
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote in messagenews:(E-Mail Removed)...
>
> > Good morning
>
> > Try this
>
> > See this two lines
>
> > 'Enter the file names in the C:K column in each row
> > 'Enter the CC addresses in the L:P column in each row
> > Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
> > Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>
> > Sub Send_Files_test()
> > 'Working in 2000-2007
> > Dim OutApp As Object
> > Dim OutMail As Object
> > Dim sh As Worksheet
> > Dim cell As Range, FileCell As Range
> > Dim rng As Range, rng2 As Range
> > Dim CCcell As Range
> > Dim strCC As String
>
> > 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("B").Cells.SpecialCells(xlCellTypeConstants)
>
> > 'Enter the file names in the C:K column in each row
> > 'Enter the CC addresses in the L:P column in each row
> > Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
> > Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>
> > If cell.Value Like "?*@?*.?*" And _
> > Application.WorksheetFunction.CountA(rng) > 0 Then
> > Set OutMail = OutApp.CreateItem(0)
>
> > With OutMail
> > .To = cell.Value
>
> > For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
> > If CCcell.Value Like "?*@?*.?*" Then
> > strCC = strCC & CCcell.Value & ";"
> > End If
> > Next CCcell
> > If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
>
> > .CC = strCC
> > .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
> > .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
>
> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:b2560163-04c7-4a3d-bafe-(E-Mail Removed)...
> >> Hi Ron,
>
> >> After I sent my initial email, I tested with additional email
> >> addresses in the table I use. The result was of course a fresh email
> >> for every address.
>
> >> What I would like to do though is have a core number of "To" email
> >> addressses and a dynamic list of "cc" addresses if that is possible.
>
> >> Cheers
>
> >> Bob
>
> >> On Jun 8, 5:03 am, Ozbobeee <ozbob...@gmail.com> wrote:
> >>> Hi Ron,
>
> >>> Yes they are.
>
> >>> Cheers
>
> >>> Bob
>
> >>> On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>
> >>> > Seehttp://www.rondebruin.nl/mail/tips2.htm
>
> >>> > Are your mail addresses also in the table ?
>
> >>> > --
>
> >>> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> >>> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
> >>> > > Hi All,
>
> >>> > > Background:
> >>> > > One base workbook creates separate workbooks with appropriate data
> >>> > > for each team, then displays each of the teams emails (12) ready to
> >>> > > send. At this stage I manually include people to cc the email to (this
> >>> > > varies between the 12 emails) then send.
>
> >>> > > Outcome:
> >>> > > I would like to automate this process if I could.
>
> >>> > > Detail:
> >>> > > I have the following email code (thanks to Ron DeBruin) in the base
> >>> > > workbook, but would like to add one or more cc's to it as well.
>
> >>> > > Not sure if this is possible but would appreciate any assistance
> >>> > > please?
>
> >>> > > Regards
>
> >>> > > Bob
>
> >>> > > Sub Send_Files2()
>
> >>> > > ' Loops through email addresses, attaches appropriate TL file to new
> >>> > > email, then sends.
> >>> > > Dim OutApp As Object
> >>> > > Dim OutMail As Object
> >>> > > Dim sh As Worksheet
> >>> > > Dim cell As Range, FileCell As Range, rng As Range
>
> >>> > > Sheets("Sheet15").Select
> >>> > > Sheets("Sheet15").Select
> >>> > > Columns("C:C").Select
> >>> > > Selection.ClearContents
> >>> > > Columns("G:G").Select
> >>> > > Selection.Copy
> >>> > > Range("C1").Select
> >>> > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> >>> > > SkipBlanks _
> >>> > > :=False, Transpose:=False
> >>> > > Application.CutCopyMode = False
> >>> > > Range("A1").Select
>
> >>> > > With Application
> >>> > > .EnableEvents = False
> >>> > > .ScreenUpdating = False
> >>> > > End With
>
> >>> > > Set sh = Sheets("Sheet15")
>
> >>> > > Set OutApp = CreateObject("Outlook.Application")
> >>> > > OutApp.Session.Logon
>
> >>> > > For Each cell In
> >>> > > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>
> >>> > > 'Enter the file names in the C:Z column in each row if
> >>> > > multiple files to attach
> >>> > > 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 = "Subject - " & cell.Offset(0, 4).Value
> >>> > > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
> >>> > > vbNewLine & vbNewLine & _
> >>> > > " The attached file details your team's
> >>> > > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
> >>> > > " Regards,"
>
> >>> > > 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
>
> >>> > > .Display 'Or use Send
> >>> > > '.Send
> >>> > > End With
>
> >>> > > Set OutMail = Nothing
> >>> > > End If
> >>> > > Next cell
>
> >>> > > Set OutApp = Nothing
>
> >>> > > With Application
> >>> > > .EnableEvents = True
> >>> > > .ScreenUpdating = True
> >>> > > End With
>
> >>> > > Sheets("Main").Select
> >>> > > End Sub

Hi Ron,

Many thanks for taking the time to assist.
The code works a treat.

Cheers

Bob
Maitland Australia

You are welcome Bob

--

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


"Ozbobeee" <(E-Mail Removed)> wrote in message news:f8f7ec65-14c3-4e9f-9f41-(E-Mail Removed)...
> On Jun 8, 8:00 pm, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>> Oops
>>
>> Use this one
>>
>> Sub Send_Files_test()
>> 'Working in 2000-2007
>> Dim OutApp As Object
>> Dim OutMail As Object
>> Dim sh As Worksheet
>> Dim cell As Range, FileCell As Range
>> Dim rng As Range, rng2 As Range
>> Dim CCcell As Range
>> Dim strCC As String
>>
>> 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("B").Cells.SpecialCells(xlCellTypeConstants)
>>
>> 'Enter the file names in the C:K column in each row
>> 'Enter the CC addresses in the L:P column in each row
>> Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
>> Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>>
>> If cell.Value Like "?*@?*.?*" And _
>> Application.WorksheetFunction.CountA(rng) > 0 Then
>> Set OutMail = OutApp.CreateItem(0)
>>
>> With OutMail
>> .To = cell.Value
>>
>> On Error Resume Next
>> For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
>> If CCcell.Value Like "?*@?*.?*" Then
>> strCC = strCC & CCcell.Value & ";"
>> End If
>> Next CCcell
>> If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
>> On Error GoTo 0
>>
>> .CC = strCC
>> .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
>> .Display 'Or use Display
>> End With
>>
>> Set OutMail = Nothing
>> End If
>> strCC = ""
>> Next cell
>>
>> Set OutApp = Nothing
>>
>> With Application
>> .EnableEvents = True
>> .ScreenUpdating = True
>> End With
>> End Sub
>>
>> --
>>
>> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>>
>> "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote in messagenews:(E-Mail Removed)...
>>
>> > Good morning
>>
>> > Try this
>>
>> > See this two lines
>>
>> > 'Enter the file names in the C:K column in each row
>> > 'Enter the CC addresses in the L:P column in each row
>> > Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
>> > Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>>
>> > Sub Send_Files_test()
>> > 'Working in 2000-2007
>> > Dim OutApp As Object
>> > Dim OutMail As Object
>> > Dim sh As Worksheet
>> > Dim cell As Range, FileCell As Range
>> > Dim rng As Range, rng2 As Range
>> > Dim CCcell As Range
>> > Dim strCC As String
>>
>> > 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("B").Cells.SpecialCells(xlCellTypeConstants)
>>
>> > 'Enter the file names in the C:K column in each row
>> > 'Enter the CC addresses in the L:P column in each row
>> > Set rng = sh.Cells(cell.Row, 1).Range("C1:K1")
>> > Set rng2 = sh.Cells(cell.Row, 1).Range("L1:P1")
>>
>> > If cell.Value Like "?*@?*.?*" And _
>> > Application.WorksheetFunction.CountA(rng) > 0 Then
>> > Set OutMail = OutApp.CreateItem(0)
>>
>> > With OutMail
>> > .To = cell.Value
>>
>> > For Each CCcell In rng2.SpecialCells(xlCellTypeConstants)
>> > If CCcell.Value Like "?*@?*.?*" Then
>> > strCC = strCC & CCcell.Value & ";"
>> > End If
>> > Next CCcell
>> > If Len(strCC) > 0 Then strCC = Left(strCC, Len(strCC) - 1)
>>
>> > .CC = strCC
>> > .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
>> > .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
>>
>> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:b2560163-04c7-4a3d-bafe-(E-Mail Removed)...
>> >> Hi Ron,
>>
>> >> After I sent my initial email, I tested with additional email
>> >> addresses in the table I use. The result was of course a fresh email
>> >> for every address.
>>
>> >> What I would like to do though is have a core number of "To" email
>> >> addressses and a dynamic list of "cc" addresses if that is possible.
>>
>> >> Cheers
>>
>> >> Bob
>>
>> >> On Jun 8, 5:03 am, Ozbobeee <ozbob...@gmail.com> wrote:
>> >>> Hi Ron,
>>
>> >>> Yes they are.
>>
>> >>> Cheers
>>
>> >>> Bob
>>
>> >>> On Jun 8, 12:00 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>>
>> >>> > Seehttp://www.rondebruin.nl/mail/tips2.htm
>>
>> >>> > Are your mail addresses also in the table ?
>>
>> >>> > --
>>
>> >>> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>>
>> >>> > "Ozbobeee" <ozbob...@gmail.com> wrote in messagenews:17b80472-532d-4440-a38c-(E-Mail Removed)...
>> >>> > > Hi All,
>>
>> >>> > > Background:
>> >>> > > One base workbook creates separate workbooks with appropriate data
>> >>> > > for each team, then displays each of the teams emails (12) ready to
>> >>> > > send. At this stage I manually include people to cc the email to (this
>> >>> > > varies between the 12 emails) then send.
>>
>> >>> > > Outcome:
>> >>> > > I would like to automate this process if I could.
>>
>> >>> > > Detail:
>> >>> > > I have the following email code (thanks to Ron DeBruin) in the base
>> >>> > > workbook, but would like to add one or more cc's to it as well.
>>
>> >>> > > Not sure if this is possible but would appreciate any assistance
>> >>> > > please?
>>
>> >>> > > Regards
>>
>> >>> > > Bob
>>
>> >>> > > Sub Send_Files2()
>>
>> >>> > > ' Loops through email addresses, attaches appropriate TL file to new
>> >>> > > email, then sends.
>> >>> > > Dim OutApp As Object
>> >>> > > Dim OutMail As Object
>> >>> > > Dim sh As Worksheet
>> >>> > > Dim cell As Range, FileCell As Range, rng As Range
>>
>> >>> > > Sheets("Sheet15").Select
>> >>> > > Sheets("Sheet15").Select
>> >>> > > Columns("C:C").Select
>> >>> > > Selection.ClearContents
>> >>> > > Columns("G:G").Select
>> >>> > > Selection.Copy
>> >>> > > Range("C1").Select
>> >>> > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
>> >>> > > SkipBlanks _
>> >>> > > :=False, Transpose:=False
>> >>> > > Application.CutCopyMode = False
>> >>> > > Range("A1").Select
>>
>> >>> > > With Application
>> >>> > > .EnableEvents = False
>> >>> > > .ScreenUpdating = False
>> >>> > > End With
>>
>> >>> > > Set sh = Sheets("Sheet15")
>>
>> >>> > > Set OutApp = CreateObject("Outlook.Application")
>> >>> > > OutApp.Session.Logon
>>
>> >>> > > For Each cell In
>> >>> > > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
>>
>> >>> > > 'Enter the file names in the C:Z column in each row if
>> >>> > > multiple files to attach
>> >>> > > 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 = "Subject - " & cell.Offset(0, 4).Value
>> >>> > > .Body = " Hi " & cell.Offset(0, 3).Value & "," &
>> >>> > > vbNewLine & vbNewLine & _
>> >>> > > " The attached file details your team's
>> >>> > > statistics " & cell.Offset(0, 4).Value & vbNewLine & vbNewLine & _
>> >>> > > " Regards,"
>>
>> >>> > > 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
>>
>> >>> > > .Display 'Or use Send
>> >>> > > '.Send
>> >>> > > End With
>>
>> >>> > > Set OutMail = Nothing
>> >>> > > End If
>> >>> > > Next cell
>>
>> >>> > > Set OutApp = Nothing
>>
>> >>> > > With Application
>> >>> > > .EnableEvents = True
>> >>> > > .ScreenUpdating = True
>> >>> > > End With
>>
>> >>> > > Sheets("Main").Select
>> >>> > > End Sub
>
> Hi Ron,
>
> Many thanks for taking the time to assist.
> The code works a treat.
>
> Cheers
>
> Bob
> Maitland Australia