VBA 电子邮件用户仅一次答案

【问题标题】：VBA Email Users Only OnceVBA 电子邮件用户仅一次
【发布时间】：2015-01-22 17:08:03
【问题描述】：

我参与了一项计划，该计划允许教师为学业困难的大学生提交推荐信。然后，我们会联系学生并建议可能使他们受益的资源。我正在使用电子表格来跟踪我们与学生的通话结果，并且需要能够自动向教师发送后续电子邮件，提醒他们我们通话的结果。我正在使用以下代码来执行此操作，但每次运行代码时，它都会向列表中的所有教员发送电子邮件。

是否有一个代码可以附加到此底部，以识别每行末尾的电子邮件何时发送？如果是这样，是否有代码让 Excel/Outlook 仅向未通过电子邮件发送的用户发送电子邮件？这有意义吗？

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 2 To 4 'data in rows 2-4
'       Get the email address
        Email = Cells(r, 9)

'       Message subject
        Subj = "Success Connect Referral Update"

'       Compose the message
        Msg = ""
        Msg = Msg & "Hello "
        Msg = Msg & "Student Success Center Peer Callers attempted to reach out to: "
        Msg = Msg & Cells(r, 1).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "The following interaction occured: "
        Msg = Msg & Cells(r, 7).Text & "." & vbCrLf & vbCrLf


        Msg = Msg & "Mike Dial" & vbCrLf
        Msg = Msg & "Coordinator of Early Intervention" & vbCrLf
        Msg = Msg & "Student Success Center"

'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
'       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%s"
    Next r
End Sub

【问题讨论】：

Cells(r, x).Value = "Sent" 其中x 是第一个空白列（我不知道你用了多少列）。

标签： excel vba email

【解决方案1】：

在电子邮件地址之后添加一个新的“电子邮件”列，例如第 10 (J) 列。

发送电子邮件后，将单元格值设置为某个值，下次检查。

For r = 2 To 4 'data in rows 2-4
    if Cells(r, 10).Value = "" then
'       Get the email address
        Email = Cells(r, 9)

        .. rest of code ..

        Cells(r, 10).Value = "Sent: " & Now
    end if
Next r

【讨论】：

【解决方案2】：

使用 sendkeys 方法真的很糟糕，应该避免。鉴于您同时拥有 Excel 和 Outlook，您可以在 Excel 中开发一个 VBA 程序，该程序将扫描您在 Excel 中的列并根据特定条件发送电子邮件。

【讨论】：