Question

我在一个包含Access中联系人的表中有一个包含邮件地址的列。我想使用带有签名，徽标和免责声明的模板向表格中的每个联系人发送电子邮件。我设法找到了模板的代码，但我不知道如何将其发送给表格中的所有联系人。这是我的代码：

Sub sendmail()

Dim strEmail As String
Dim strSubject As String
Dim objOutlook As Object
Dim objMailItem As Object


Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)
Set objMailItem = objOutlook.CreateItemFromTemplate("C:\Users\user\AppData\Roaming\Microsoft\Templates\Template.oft")



strEmail = "mail@test.com"
strSubject = "Test"
objMailItem.To = strEmail
objMailItem.Subject = strSubject



objMailItem.Display



End Sub

有什么建议吗？感谢

Answer 1

设置您的strEmail变量以列出表格中的所有电子邮件地址。你可以这样做：

Private Sub sendmail()

    Dim strEmail As String
    Dim strSubject As String
    Dim objOutlook As Object
    Dim objMailItem As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMailItem = objOutlook.CreateItem(olMailItem)
    Set objMailItem = objOutlook.CreateItemFromTemplate("C:\Users\user\AppData\Roaming\Microsoft\Templates\Template.oft")

    'set email addresses
    strEmail = "mail@test.com"

    Dim rs As Recordset
    Dim sql As String
    Dim i As Integer

    sql = "SELECT fldEmailAddress FROM tblContacts"
    Set rs = CurrentDb.OpenRecordset(sql)

    With rs
        If Not .EOF And Not .BOF Then
            .MoveLast
            .MoveFirst

            For i = 0 To .RecordCount - 1
                If i = 0 Then
                    strEmail = !fldEmailAddress
                Else
                    strEmail = strEmail & "; " & !fldEmailAddress
                End If
                .MoveNext
            Next
        End If
    End With

    strSubject = "Test"
    objMailItem.to = strEmail
    objMailItem.Subject = strSubject

    objMailItem.Display
End Sub

发送电子邮件给表中的每个联系人访问VBA

1 个答案: