Question

大家好，我是VBA编程的新手，已经在这里工作了一个星期。我正在努力学习编写自己的代码，但我提出了一个问题。

我的最终结果是我向所有供应商发送了一封电子邮件，其名称在BCC字段中。我当前的代码为每个联系人创建一个不需要的电子邮件。我确信这是一个简单的修复，但到目前为止这是我的代码。感谢您的帮助！

 Private Sub Compose_Button_Click()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.mailItem
Dim objOultlookRecip As Outlook.Recipients
Dim objOutlookAttach As Outlook.Attachments
Dim TheAddress As String

Set db = CurrentDb
Set rst = Me.Recordset
rst.MoveFirst

Set objOutlook = CreateObject("Outlook.Application")

Do Until rst.EOF

'Create Email message

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = rst![E-Mail]

    With objOutlookMsg
    Set objOutlookRecip = .Recipients.Add(TheAddress)
    objOutlookRecip.Type = olBCC

objOutlookMsg.Display

End With

rst.MoveNext

Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing


End Sub

谢谢！

Answer 1

如果您只需要汇编一个唯一的电子邮件地址列表，那么您可以循环（克隆）表单的Recordset并将值填充到Dictionary对象中，然后遍历Dictionary发送电子邮件。这将是这样的：

Option Compare Database
Option Explicit

Private Sub Command0_Click()
Dim rst As DAO.Recordset
Dim EmailAddresses As Object  ' Dictionary
Dim EmailAddress As Variant

Set rst = Me.RecordsetClone
If Not (rst.EOF And rst.BOF) Then
    rst.MoveFirst
    Set EmailAddresses = CreateObject("Scripting.Dictionary")  ' New Dictionary
    Do Until rst.EOF
        If Not IsNull(rst("E-mail").Value) Then
            If Not EmailAddresses.Exists(rst("E-mail").Value) Then
                EmailAddresses.Add rst("E-mail").Value, ""
            End If
        End If
        rst.MoveNext
    Loop
    For Each EmailAddress In EmailAddresses.Keys
        ' send your email to EmailAddress here
    Next
    Set EmailAddresses = Nothing
End If
Set rst = Nothing
End Sub

使用VBA Access 2007通过电子邮件发送多个查询结果

1 个答案: