每小时执行 VBA 脚本有困难

Question

我正在尝试每隔一小时左右让这个 VBA 脚本（如果任务到达截止日期，它会向我发送一封电子邮件）。我查看了周围的教程并尝试了一些示例，但每次我尝试运行时都会收到一条消息。任何人都可以快速浏览一下吗？

谢谢！

Option Explicit

Private Sub TaskTracker()
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"

'Equals 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 = "fmal@ox.com"
                    strCC = "fs@ox.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
Call AutoRun
End Sub


Sub AutoRun()
Application.OnTime Now + TimeValue("00:00:10"), "TaskTracker"
End Sub

据我了解，脚本应该在结束自身之前调用 AutoRun sub。但事实并非如此。当我尝试手动运行 AutoRun 子本身时，它显示 "Cannot run the macro "*\Task Tracker.clsm'TaskTracker'。此工作簿中可能没有宏，或者所有宏都被禁用。"

Answer 1

一切正常。感谢大家！（留下答案我可以将此主题标记为已回答）:)

下面的代码非常适合我。正如 Kathara 所建议的那样，Call Autorun 必须放在 Next Formula Cell 之后。此外，我不得不录制一个空白宏，并复制粘贴整个循环检查代码才能正常工作！

Option Explicit

Private Sub TaskTracker()
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"

MyLimit = Date

Set FormulaRange = Range("E5:E35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    strTO = "Fr@Aion.com"
                    strCC = ""
                    strBCC = ""
                    strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "A").Value
                    strBody = "Hello Sir, " & vbNewLine & vbNewLine & _
                        "This email is to notify that you that your task : " & Cells(FormulaCell.Row, "A").Value & " with the following note: " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date." & vbNewLine & "It would be wise to complete this task before it expires!" & _
                        vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager v1.0"
                    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
Call AutoRun

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

MsgBox "Some Error occurred." _
     & vbLf & Err.Number _
     & vbLf & Err.Description

End Sub

Sub AutoRun()
Application.OnTime Now + TimeValue("00:00:20"), "TaskTracker"
End Sub

感谢大家的帮助！

每小时执行 VBA 脚本有困难

Difficulties with Executing VBA Script every hours

excel

vba

autorun