1

我需要访问它，以便在他们的出生日期在 3 天内向某个客户发送电子邮件。

Dim rs as dao.recordset
set rs = currentdb.openrecordset(“DiscountEmail”)
with rs
    if .eof and .bof then (No Records found for this query.)
        Msgbox “ No emails will be sent because there are no records from the query ‘DiscountEmail’ “
    else
        do until .eof 

            DoCmd.SendObject acSendNoObject, , , ![Email Address Field], , , “Happy Birthday!”, “Hello ” & ![First Name Field] & _
                    “, ” & Chr(10) & “Come in on your birthday and receive a 10% discount!”, False

            .edit
            ![Email_Sent_Date] = now()
            .update
            .movenext 
        loop

    End If
end with

If Not rs Is Nothing Then
    rs.Close
    Set rs = Nothing
End If

我有这个代码，但现在我只需要这样做，如果某个客户的生日（在我的表“CustomerInfo”中）在 3 天内，它会向他们发送一封电子邮件，说他们可以在生日那天进来并收到一个折扣。

另外，我想让它自动发生（所以我不必按任何按钮），但它只发送一次，所以我可以明年再发送一次。

提前致谢！:)

4

2 回答 2

2

您需要有一些事件才能触发此事件。Access 数据库只是一个文件，因此当您不使用它时，它不会运行任何代码。

每次打开数据库时都做一个简单的检查，也许在第一个表单的 On Load 事件上是要走的路。我假设您的DiscountEmailRecordSet 是在 3 天内查询电子邮件的记录集。

您的解决方案是将其放在第一个表单的 onLoad 事件中或使用其他服务。只要不多次向收件人发送垃圾邮件，只需添加一个emailSent字段或将已发送的电子邮件记录到不同的表中，并在电子邮件发送后进行处理。

查找相关电子邮件的示例查询：

Select email from Users Where dateOfBirth between dateAdd("d",-3,Date()) AND dateAdd("d",3,Date());

发送电子邮件，您可以使用 SMTP 和 CDO。创建一个名为类似的电子邮件功能sendEmail

 Public Sub SendEmail(strTo as STring, strFrom as String, strSubj as String, strBody as String)
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String

Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields

' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "mail.myserver.com" 'your info here
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email@email.com"  'more of your info
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update

With imsg
    .To = strTo
    .From = strFrom
    .Subject = strSubj
    .HTMLBody = strBody
    '.body    = strBody
    '.Sender = "Sender"
    '.Organization = "My Company"
    '.ReplyTo = "address@mycompany.com"
    Set .Configuration = iconf
    .Send
End With

Set iconf = Nothing
Set imsg = Nothing
Set flds = Nothing
 End Sub

您可以遍历查询的结果集并为每封电子邮件调用 sendmail 函数，或者编写一个快速帮助函数，将您的电子邮件字段获取并连接到“;” 分隔列表，只需将电子邮件与多个收件人一起发送一次。

于 2013-04-04T03:11:24.240 回答
0

如果您的问题的本质是关于电子邮件本身的实际发送，那么您可能会发现这DoCmd.SendObject可能不是最好的方法。它有几个限制，最重要的是（参考：here）

  • 消息文本限制为 255 个字符
  • 它取决于与电子邮件客户端应用程序的交互（我假设是通过 MAPI），因此如果没有配置邮件客户端，或者邮件客户端不是 Microsoft 产品，它可能无法工作

相反，您可以考虑通过 CDO 发送消息。这里有一篇很好的文章和一些现成的 VBA 代码：

http://www.cpearson.com/excel/Email.aspx

于 2013-04-04T12:41:51.277 回答