Question

我正在尝试在MS Access 2013中添加VBA代码，该代码将从指向表的查询中获取电子邮件并填充Outlook中的.BCC字段。我能够使用.recipients.add字符串功能成功地在.To字段中填充电子邮件，但是无法弄清楚如何在Outlook的.BCC字段中执行相同的操作。

我尝试了数十个示例，而我得到的最接近的示例是将表格中的最后一封电子邮件填充到.BCC字段中。

Private Sub Command180_Click()
    Dim rs As DAO.Recordset
    Dim OlApp As Object
    Dim OlMail As Object
    Dim strEmail As String

    Set OlApp = CreateObject("Outlook.Application")
    Set OutMail = OlApp.CreateItem(olMailItem)

    Set rs = CurrentDb.OpenRecordset("SELECT POCEmail FROM qDistroActiveEmails")
    With rs
        Do Until .EOF
            strEmail = !PocEmail

            With OutMail
                .BCC = strEmail
                .Recipients.Add strEmail
            End With

            rs.MoveNext
        Loop
    End With
    rs.Close
    Set rs = Nothing

    OutMail.Display

End Sub

如果我可以得到上面的代码来填充.BCC字段，那就太好了。

Answer 1

Recipients.Add返回一个Recipient对象（您的代码将忽略该对象）。将其Type属性设置为olBCC（3）

Dim recip as Object
...
With OutMail
  set recip = .Recipients.Add(strEmail)
  recip.Type = 3
End With

Answer 2

BCC属性接受一串用分号分隔的电子邮件地址。还要注意，此代码将电子邮件添加到收件人和密件抄送，这意味着它们将收到重复的电子邮件。如果您只想盲目复制它们，请不要将它们添加到收件人中。

改为使用此：

Private Sub Command180_Click()
    Dim rs As DAO.Recordset
    Dim OlApp As Object
    Dim OutMail As Object
    Dim strEmail As String
    Dim bccEmails As String

    Set OlApp = CreateObject("Outlook.Application")
    Set OutMail = OlApp.CreateItem(olMailItem)

    Set rs = CurrentDb.OpenRecordset("SELECT Email FROM Emails")
    With rs
        Do Until .EOF
            strEmail = !Email
            ' add email to BCC email list string
            bccEmails = bccEmails & strEmail & ";"

            With OutMail
                .Recipients.Add strEmail
            End With

            rs.MoveNext
        Loop
    End With
    rs.Close
    Set rs = Nothing

    ' set BCC using string of concatenated emails                  
    OutMail.BCC = left(bccEmails, Len(bccEmails) - 1) ' trims trailing semicolon

    OutMail.Display

End Sub

如何创建具有ms访问权限的电子邮件，该电子邮件将使用VBA从查询中获取电子邮件地址

2 个答案: