向表中的每个联系人发送电子邮件Access VBA [英] Send email to every contact in a table Access VBA

问题描述

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

I have a column with mail addresses in a table with contacts in Access. I want to send an email to every contact in the table using a template which has signature, logo, and disclaimer. I managed to find a code for the template but I don't know how to send it to all contacts in the table. Here is my code:

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 = "[e-mail]"
strSubject = "Test"
objMailItem.To = strEmail
objMailItem.Subject = strSubject



objMailItem.Display



End Sub

有什么建议怎么做? 谢谢

Any suggestions how to do it? Thanks

推荐答案

设置您的strEmail变量以列出表中的所有电子邮件地址.您可以执行以下操作:

set your strEmail variable to list all the email addresses in your table. You can do something like this:

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 = "[e-mail]"

    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

这篇关于向表中的每个联系人发送电子邮件Access VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！