我想發送生日祝福，我有一個包含他們的電子郵件地址和日期的串列。
如何過濾日期的問題很清楚，但我不知道如何復制電子郵件地址并發送。
我知道如何復制內容，但 Outlook 不支持該粘貼配置。
請參閱下面我的實際設定不起作用：
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
uj5u.com熱心網友回復：
您無需將電子郵件地址復制到剪貼板并粘貼。您可以直接設定To/ CC/BCC屬性字串與一個單一的電子郵件地址或";"電子郵件地址的串列。
.BCC = Range("M4:M5").Text
更新以下腳本對我來說很好用：
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
更新 2：在我的頭頂上：
for each r in Application.Range("B2:B6")
set recip = OutlookMail.Recipients.Add(r.Text)
recip.Type = 3 'olBCC
next
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/397061.html