Question

我需要访问它，以便当他们的出生日期在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天内，它会向他们发送一封电子邮件说他们可以在他们的生日那天进来并获得折扣。

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

提前致谢！：）

Answer 1

您需要举办一些活动才能解雇此活动。 Access数据库只是一个文件，因此当您不使用它时，它不会运行任何代码。

每次打开数据库时都要进行简单的检查，也许在第一个表单的On Load事件上就可以了。我假设您的DiscountEmail RecordSet是在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函数，也可以编写一个快速帮助函数来获取并将您的电子邮件字段连接到“;”分隔列表，只需向多个收件人发送一次电子邮件。

Answer 2

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

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

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

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

如果DOB在'n'天内，则从Access发送电子邮件

2 个答案: