Need your help to add bcc

[Excelmasters]

Hi All,

can anyone help me to add BCC to multiple receipts which i have saved in sheet 1 G2 to lrow ..

help greatly appreciated

Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Msg As String
Set olApp = New Outlook.Application
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
LR = Range("B" & Rows.Count).End(xlUp).Row
For Each cell In Range("B2:B" & LR)
If Month(cell) = Month(Date) And Day(cell) = Day(Date) Then
Pos = WorksheetFunction.Find(" ", cell.Offset(, -1))
FName = Left(cell.Offset(, -1), Pos - 1)
Subj = "Happy B'day"
EmailAddr = cell.Offset(, 1).Value
Msg = "Dear " & FName & "," & vbNewLine
Msg = Msg & vbNewLine & " Happy Birthday to you and many more happy returns. Have a wonderful day." & vbCrLf & vbCrLf

Set MItem = olApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Msg
.Send
End With
End If
Next

Application.ScreenUpdating = True
[COLOR=#333333]End Sub[/COLOR]

 

[Domenic]

First, create a string delimited by a semi-colon from the list of names in Column G, and assign it to a string variable...

    Dim sBCCRecipients As String

    sBCCRecipients = Join(Application.Transpose(Range("G2:G" & lrow)), ";")

Then set the BCC property...

.BCC = sBCCRecipients

Hope this helps!

 

[Excelmasters]

thank you it worked

 

[Domenic]

You're very welcome!