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(xlCellTypeConstants)

'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
(E-Mail Removed)



<(E-Mail Removed)> wrote in message
news:77dfe6a9-f598-4d6b-90da-(E-Mail Removed)...
>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(xlCellTypeConstants)
>
> '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
>
>
>