Блог

В MS Access 2013 я пытаюсь получить адреса электронной почты из запроса, указывающего на таблицу, и заполнить .BCC поле в электронном письме Outlook.

Я могу заполнить .To поле адресами электронной почты, используя .recipients.add .

Как я могу сделать то же самое в .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
  

Recipients.Add возвращает Recipient объект (который ваш код игнорирует). Установите для его свойства Type значение olBCC (3)

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

Свойство BCC принимает строку адресов электронной почты, разделенных точкой с запятой. Также обратите внимание, что этот код добавляет электронные письма получателям и 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 amp; strEmail amp; ";"

            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