Paste cells in Outlook E-mail Adress-CodePudding

I want to send birthday greetings, I have a list with their e-mail address and date.

The question about How to filter the date is clear, but I don't know how to copy the e-mail address and send.

I know how to copy the content, but the Outlook doesn't support that configuration for the pasting.

See below my actual set that doesn't work:

Sub Envia_Emails()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
         
    Call Filtrar_aniversario
    Worksheets("Query").Activate
    Activated.Cells(2, 2).Copy
   
    
    With OutlookMail
        .To = ""
        .CC = ""
        .BCC = PasteSpecial
        .Subject = "Feliz Aniversário!"
        .Body = "Feliz aniversário"
        .Display ' para envia o email diretamente defina o código  .Send
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    
End Sub


Sub Filtrar_aniversario()

    Application.CutCopyMode = False
    Columns("A:D").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("M4:M5"), Unique:=False
End Sub

CodePudding user response：

You do not need to copy an email address to the clipboard and paste it. You can directly set the To / CC / BCC properties to string with either a single email address or a ";" separated list of email addresses.

.BCC = Range("M4:M5").Text

UPDATE The following scripts worked fine for me:

Sub Envia_Emails()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    'Call Filtrar_aniversario
    With OutlookMail
        .To = ""
        .CC = ""
        .BCC = Application.Range("A1:A1").Text
        .Subject = "Feliz Aniversário!"
        .Body = "Feliz aniversário"
        .Display ' para envia o email diretamente defina o código
        '.Send
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

UPDATE 2: off the top of my head:

 for each r in Application.Range("B2:B6")
   set recip = OutlookMail.Recipients.Add(r.Text)
   recip.Type = 3 'olBCC
 next