Question

虽然我对VBA一无所知，但我已经在多个社区上阅读了关于这个主题的十几个主题，试图找出一些东西，一种方法。

我找到了最有可能在我的情况下工作的脚本，分析它，切换引用，单元格等等。我想我正在接近功能性的东西，唉，我担心这是我的知识和试验＆amp;错误发生了。

脚本当前无效... E5到E35包含截止日期，每个单元格旁边的单元格包含“已发送”和“未发送”值，因此它不会发送重复的电子邮件。

这是在需要运行的工作表中：

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 = "random@adress.com"
                    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

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

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 = "random@adress.com"
                    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

好消息！下面的脚本似乎与我的文档一起正常工作。虽然它只发送仍然有时间的任务的电子邮件！我需要脚本只在日期与＆＃34;今天（）＆＃34;相同时发送电子邮件。我该怎么做？

非常确定它与＆＃34;我的极限=日期＆＃34;但是，如何更改日期以仅包括当天？

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 = "fmais@eox.com"
                    strCC = "fais@box.com"
                    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

修复此“截止日期发送电子邮件”脚本？

2 个答案: