解决这个“在截止date发送电子邮件”脚本？

尽pipe我对VBA一无所知，但我已经阅读了关于多个社区主题的十几个话题，试图找出一些办法。

我发现最有可能在我的情况下工作的脚本，分析它，切换引用，单元格等等。 我想我正在接近某些function，唉，我担心就我的知识和试验和错误而言。

该脚本目前什么都不做… E5到E35包含截止date，这些单元格旁边的单元格包含“已发送”和“未发送”值，因此它不会发送重复的电子邮件。

这是在它需要运行的表单中：

Option Explicit Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Double NotSentMsg = "Not Sent" SentMsg = "Sent" 'Above the MyLimit value it will triger the email MyLimit = Today() Set FormulaRange = Me.Range("E5:E35") On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If IsNumeric(.Value) = False Then MyMsg = "Not numeric" Else If .Value > MyLimit Then MyMsg = NotSentMsg If .Offset(0, 1).Value = NotSentMsg Then strTO = "[e-mail]" strCC = "" strBCC = "" strSub = "Greetings, " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg ' Call Mail_with_outlook2 End If Else MyMsg = NotSentMsg End If End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell ExitMacro: Exit Sub EndMacro: Application.EnableEvents = True MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description End Sub 

这是我用来发送电子邮件的模块：

 Option Explicit Public FormulaCell As Range Public strTO As String Public strCC As String Public strBCC As String Public strSub As String Public strBody As String Public strAttach As String Public Function sendMail(strTO As String, strSub As String, strBody As String, Optional strCC As String, Optional strBCC As String, Optional strAttach As String) As Boolean Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error GoTo errorMail With OutMail .To = strTO If Len(Trim(strCC)) > 0 Then .CC = strCC If Len(Trim(strBCC)) > 0 Then .BCC = strBCC .Subject = strSub .Body = strBody If Len(Trim(strAttach)) > 0 Then If Dir(strAttach, vbNormal) <> "" Then .Attachments.Add (strAttach) End If .Send End With sendMail = True exitFunction: Err.Clear On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Exit Function errorMail: MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description GoTo exitFunction End Function 

非常感谢任何帮助这个巨大的任务！

Answer 1

你可以通过一步一步的debugging来尝试下面的代码吗？ 如果出现错误，请按debugging并注释哪一行会得到什么样的错误。 我很想知道这是否让你更接近你的目的地。

 Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Date NotSentMsg = "Not Sent" SentMsg = "Sent" MyLimit = Date Set FormulaRange = Me.Range("E5:E35") 'On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If (IsDate(.Value) = True) Then If (.Value > MyLimit) Then If .Offset(0, 1).Value = NotSentMsg Then strTO = "[e-mail]" strCC = "" strBCC = "" strSub = "Greetings, " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" Call sendMail(strTO, strSub, strBody, strCC) MyMsg = SentMsg End If Else MyMsg = NotSentMsg End If End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell 'EndMacro: 'Application.EnableEvents = True 'MsgBox "Some Error occurred." _ ' & vbLf & Err.Number _ ' & vbLf & Err.Description End Sub 

Answer 2

好消息！ 下面的脚本似乎与我的文档正常工作。 虽然它只发送电子邮件的任务，仍然有时间了！ 我只需要脚本发送一个电子邮件只有当date是相同的“今天（）”我该怎么做？

很确定这是与“我的限制=date”行，但如何更改date只包括当天？

 Option Explicit Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Double NotSentMsg = "Not Sent" SentMsg = "Sent" 'Above the MyLimit value it will triger the email MyLimit = Date Set FormulaRange = Me.Range("E5:E35") On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If .Value > MyLimit Then MyMsg = NotSentMsg If .Offset(0, 1).Value = NotSentMsg Then strTO = "[e-mail]" strCC = "[e-mail]" strBCC = "" strSub = "Greetings " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir, " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg ' Call Mail_with_outlook2 End If Else MyMsg = NotSentMsg End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell ExitMacro: Exit Sub EndMacro: Application.EnableEvents = True MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description End Sub