1

大家好，我是 VBA 编程的新手，已经学习了一周。我正在尝试学习编写自己的代码，但我遇到了一个问题。

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

 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

谢谢！！

4

1 回答 1

0

如果您只需要组装一个唯一电子邮件地址的列表，那么您可以遍历（克隆）表单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
于 2013-10-21T18:51:16.087 回答