I can send out with different attached workbook by different email
address (to:), but if I need to send email with cc and bcc, how can I
do it?

column B = .To
column C = .cc
column D = .Bcc

Below is my marco, please help me. Thanks!

Sub Send_Files()
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("SendFiles")

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

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

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

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

With OutMail
.To = cell.Value
.Cc = ""
.Bcc = ""
.Subject = cell.Offset(0, -1).Value & " SmarTone-
Vodafone Bill" & " - " & Format(Now, "mmmm yy")
.Body = "Dear Customer," & vbNewLine & vbNewLine & _
"Please contact us on or before " &
Format(Now, "mmmm")

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

Try this.....

..To = cell.Value
..Cc = cell.offset(0,1).value
..Bcc = cell.offset(0,2).value

--

Regards,
Nigel




wrote in message
...
I can send out with different attached workbook by different email
address (to:), but if I need to send email with cc and bcc, how can I
do it?

column B = .To
column C = .cc
column D = .Bcc

Below is my marco, please help me. Thanks!

Sub Send_Files()
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("SendFiles")

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

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

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

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

With OutMail
.To = cell.Value
.Cc = ""
.Bcc = ""
.Subject = cell.Offset(0, -1).Value & " SmarTone-
Vodafone Bill" & " - " & Format(Now, "mmmm yy")
.Body = "Dear Customer," & vbNewLine & vbNewLine & _
"Please contact us on or before " &
Format(Now, "mmmm")

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