每小时执行VBA脚本的困难

时间:2016-01-28 15:19:50

标签: excel vba excel-vba autorun

我正在尝试每小时左右使用此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子。但事实并非如此。 当我尝试手动运行AutoRun子程序时,它会指出“无法运行宏”* \ Task Tracker.clsm'TaskTracker'。宏可能在此工作簿中不可用,或者可能禁用所有宏。“

1 个答案:

答案 0 :(得分:2)

一切正常。感谢大家! (留下答案我可以将这个主题标记为已回答):)

以下代码适合我。正如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

感谢大家的帮助!