Question

我的Excel电子表格通过电子邮件发送了B列中的电子邮件地址，电子邮件将发送到该电子邮件地址，以及电子邮件要发送到的E列中的地址。在A1我有今天的日期（更新），在B1我有电子邮件需要发送的日期，在C1我有另一个日期6个月后需要发送电子邮件。

这是我的代码：

Private Sub workbook_Open()
Dim Subject, Send_From, Send_To, cc, body As String
Dim Email_Range, cl, cc_Range, cx As Range
Dim Due_Date, Today_Date, Send_Date As Date
Today_Date = Range ("A1").Text
Due_Date = Today_Date + 7
Send_Date = Range ("B1").Text
Dim Mail_Object, Mail_Single As Variant

Set Email_Range = Range("B3:B14")
For Each cl In Email_Range
    Sent_To = Send_To & ";" & cl.Value
Next
Send_To = Mid(Send_To, 2)

Set cc_Range = Range("E3:E14")
    For Each cx In cc_Range
        cc = cc & ";" & cx.Value
    Next
    cc = Mid(cc, 2)

Subject="subject"
Send_From="me@example.com"
Body="Please respond by" & "Due_Date" & "Thank You"

On Error GoTo debugs

Set Mai_Object = Create Object ("Outlook Application")
Set Mail_Single - Mail_Object, Create Item(0)
With Mail_Single
    .Subject=Subject
    .To=Send_To
    .cc=cc
    .Body=Body
    .Send
End With

debugs:
If Err.Description c>"" Then Msg Box
Err.Description

End Sub

程序将在我运行时发送电子邮件，但我需要程序在发送日期自动发送电子邮件（截止日期=发送日期），然后当有人回复时，将其从电子邮件列表中删除。重复此操作，直到每个人都响应，然后在下一个发送日期（不同的单元格）再次完成。

我不知道从哪里开始，因为我很清楚这一点。有没有人有任何想法？

Answer 1

有一个解决方案使用Excel和Outlook使用Outlook的任务提醒，但只有当您的Outlook软件在发生提醒事件时正在运行时，它才会在准确的时间发送电子邮件。如果您启动Outlook并“错过”一个或多个预定事件（因为当时Outlook已关闭），则Outlook启动后不久将发生与错过的预定事件相对应的电子邮件。我假设您在使用Excel时可以使用Outlook。

Excel组件解决方案

我创建的电子表格与您的电子表格略有不同，但您可以根据需要进行调整。电子表格有两个单独的工作表，名为“收件人”和“电子邮件”。 “收件人”表单包含每个电子邮件收件人的列表以及三个日期，如果他们尚未回复，他们应该收到电子邮件。

“电子邮件”表格包含要放在每封电子邮件中的内容：

在电子表格的ThisWorkbook代码中，我添加了以下过程。这些负责在Outlook中创建任务，以便将来在特定时间触发提醒。每项任务都将包含足够的信息，以便向指定的收件人生成电子邮件。

Sub CreateOutlookTask(name As String, destination As String, emailNum As Integer, sendDate As Date)
    With CreateObject("Outlook.Application").CreateItem(3)
        .Subject = Worksheets("Emails").Cells((emailNum + 1), "A").Value
        .Role = destination
        .StartDate = sendDate
        .DueDate = sendDate
        .ReminderTime = sendDate
        .ReminderSet = True
        .Body = Trim(Worksheets("Emails").Cells((emailNum + 1), "B").Value) + _
            " " + name + "," + vbLf + vbLf + _
            Worksheets("Emails").Cells(emailNum + 1, "C").Value + _
            vbLf + vbLf + _
            "This email was sent to " + destination + _
            " by XYZ Corporation [add reason]."
        .Categories = "AutoSend"
        .Save
    End With
End Sub

Sub ProcessRecipients()
    Dim rowNum As Integer
    Dim lastRowIdx As Integer
    lastRowIdx = Worksheets("Recipients").Cells(Rows.Count, "B").End(xlUp).Row
    For rowNum = 2 To lastRowIdx
        With Worksheets("Recipients")
            Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 1, .Cells(rowNum, "C"))
            Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 2, .Cells(rowNum, "D"))
            Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 3, .Cells(rowNum, "E"))
        End With
    Next
End Sub

在Excel工作簿中运行ProcessRecipients()宏将在Outlook中为“收件人”表单上列出的每个收件人创建三个任务。但是，在完成以下部分后，电子邮件 magic 才会发生。

Outlook组件解决方案

Outlook中需要执行两个单独的操作。第一个是在指定时间实际发送电子邮件，第二个是查找和处理回复。

由于响应者的电子邮件地址可能与最初预期收件人的电子邮件地址不同，因此自动处理收到的电子邮件变得更加复杂。通过将预期收件人的电子邮件地址放在原始电子邮件的正文中，很可能任何响应都将包含原始电子邮件，因此包括对最初预期收件人的引用。电子邮件的自动处理在主题标题字符串中查找已知文本，以及在收到的电子邮件正文中引用原始预期收件人的电子邮件地址。

以下VBA代码需要放在Outlook的VbaProject.OTM文件中的（新）模块中。此代码将成为Outlook客户端收到电子邮件时将运行的规则。

' Create a rule that calls this macro each time an email is received.
' All tasks that are flagged with the 'AutoSend' category will be searched
' and the email destination for that task extracted from the task's 'role'
' field. If the received email explicitly refers to that email address, then
' the task will be deleted.
'
' It cannot be assumed that the sender of a response email will be the same
' email address as the email used to send the original email (i.e. it could
' have been forwarded, or simply be an alias for the actual recipient. We
' must therefore search the body of the response to look for a reference to
' the originally intended recipient email address.
'
Sub ProcessAutoEmailResponses(email As MailItem)
    Dim task As Outlook.TaskItem
    Dim items As Outlook.items
    Dim folder As Outlook.MAPIFolder
    Dim deletedTasks As String
    Dim autoProcess As Boolean

    autoProcess = False
    Set folder = Application.Session.GetDefaultFolder(olFolderTasks)
    Set items = folder.items
    ' If the incoming email subject contains any of the strings defined
    '  by an 'AutoReceive' task category subject
    Set task = items.Find("[Categories] ='AutoReceive'")
    Do While (Not task Is Nothing) And (autoProcess = False)
        If (InStr(1, email.Subject, task.Subject) > 0) Then
            autoProcess = True
        End If
        Set task = items.FindNext
    Loop
    If (autoProcess = True) Then
        deletedTasks = "AutoSend Processing Triggered"
        ' loop through all AutoEmail categorised tasks
        Set task = items.Find("[Categories] ='AutoSend'")
        Do While (Not task Is Nothing)
            ' if the email contains a reference to the task's destination email address
            If (InStr(1, email.Body, task.Role) > 0) Then
                deletedTasks = deletedTasks & ", Deleted Reminder " & task.DueDate & " (" & task.Subject & ")"
                ' delete the task
                task.Delete
            End If
            Set task = items.FindNext
        Loop
        ' Insert note to indicate tasks have been deleted
        email.Body = deletedTasks + vbLf + email.Body
        email.Subject = "[AUTOSEND PROCESSED] " + email.Subject
        email.Save
    End If
End Sub

需要将第二个代码块放在ThisOutlookSession代码库的VbaProject.OTM区域中。只要提醒被激活，就会执行此代码。

注意有几种方法可以做到这一点，虽然我最终没有通过这个事件处理程序“取消”提醒窗口，BeforeReminderShow事件处理程序是（我相信）控制的唯一方法提醒窗口是否实际上是由于提醒发射而可见的。这可能是你想要进一步发挥的东西。

Private WithEvents olRemind As Outlook.Reminders

Private Sub Application_Reminder(ByVal item As Object)
    Set olRemind = Outlook.Reminders
End Sub

'
' Auto-dismiss/cancel reminders that would otherwise
' be displayed for "AutoSend" categorised items
'
Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)
    Dim reminderObj As Reminder
    Dim item As TaskItem
    For Each reminderObj In olRemind
        If (reminderObj.IsVisible = True) Then
            If (TypeName(reminderObj.item) = "TaskItem") Then
                If reminderObj.item.Categories = "AutoSend" Then
                    Dim email As MailItem
                    Set email = Application.CreateItem(olMailItem)
                    email.To = reminderObj.item.Role
                    email.Subject = reminderObj.item.Subject
                    email.Body = reminderObj.item.Body
                    email.Send
                    reminderObj.item.ReminderSet = False
                    reminderObj.item.Save
                    reminderObj.Dismiss
                End If
            End If
        End If
    Next
End Sub

重要提示：默认的Outlook配置下通常禁止使用Outlook宏。最好签署代码并允许执行签名的宏。一旦您的代码运行一次，您就可以指定“始终允许”运行该代码，从而消除权限问题。

此博客提供了有关“自签名”VBA项目的说明：http://www.remkoweijnen.nl/blog/2011/01/12/self-signing-word-macros/。

最后步骤

在outlook（无需日期）中创建一个或多个“任务”，其中包含电子邮件主题标题作为标题，并使用名为“AutoReceive”的类别标记它们。这些将控制根据电子邮件主题的内容自动处理哪些电子邮件。

您现在需要在Outlook中设置规则以运行ProcessAutoEmailResponses(MailItem)方法，方法是转到Tools->Manage Rules and Alerts（或类似，取决于您的Outlook版本）并创建运行该规则的规则新电子邮件到达时的方法。

Answer 2

正如先前在Matt Rowland的评论中所说，Excel并不是真正做出类似事情的正确选择。最简单的方法是使用能够发送电子邮件的SQL Server（或任何其他数据库服务器）。

主要问题是您希望Excel在特定日期/时间运行。但是，Excel并不是在您的计算机上日夜运行。因此，如果Excel未在您希望的特定日期/时间打开/运行，则Excel无法发送请求的电子邮件。

但是，如果必须使用Excel完成任务，这是可能的。首先，您必须确保您的计算机日夜运行，以便计算机在所请求的日期启动并运行。其次，您需要设置Windows任务（https://en.wikipedia.org/wiki/Windows_Task_Scheduler）以使用您为此目的设置的文件打开Excel（使用上面的代码）。要真正具体，您甚至可以使用VBA函数Application.OnTime（https://msdn.microsoft.com/en-gb/en-en/library/office/ff196165.aspx）在特定时间运行上述过程。

自动化电子邮件

2 个答案:

Excel组件解决方案

Outlook组件解决方案

最后步骤