Application.OnTime在不应该运行的时候运行

时间:2014-11-18 22:40:11

标签: excel vba email excel-vba

我编写了一个脚本,用于生成Lotus Notes电子邮件,以便按特定时间间隔发布数据。此脚本是Macro2 - Macro5。宏2 - 宏5都是相同的,但我在不同的子下复制了脚本来尝试和诊断我的问题。我遇到的问题有时是例如晚上8点,将生成4封电子邮件。一个电子邮件将由Macro 5正确触发,但是在晚上8点发送的其他电子邮件已由Macro 2触发。我知道这是因为我在每个宏中添加了一条额外的行,以在电子邮件中指示Macro生成它。

我使用以下内容来调用这些潜艇:

在“本工作手册”中,我有:

Private Sub Workbook_Open()
Call DailyAM
Call DailyPM
 End Sub

在第1单元中:

Sub DailyAM()
 Application.OnTime TimeValue("06:00:00"), "Macro2"
 Application.OnTime TimeValue("10:00:00"), "DailyAM"
End Sub

Sub DailyPM()
 Application.OnTime TimeValue("12:01:00"), "Macro3"
 Application.OnTime TimeValue("16:00:00"), "Macro4"
 Application.OnTime TimeValue("20:00:00"), "Macro5"
 Application.OnTime TimeValue("23:59:00"), "DailyPM"
End Sub

真的很困惑为什么会这样。非常肯定这个问题与Macro 2-5无关,但这里只是以防万一:

Sub Macro5()
    Windows("Silo report test v2.xlsm").Activate
Application.Calculate
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)

    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
         Maildb.OPENMAIL
     End If
    Set MailDoc = Maildb.CreateDocument

    MailDoc.Form = "Memo"


'Email address array changed for privacy
vaRecipient = VBA.Array("example@example.com")

    MailDoc.SendTo = vaRecipient

    MailDoc.Subject = Range("B1").Value

 Set workspace = CreateObject("Notes.NotesUIWorkspace")

Dim notesUIDoc As Object
Set notesUIDoc = workspace.EditDocument(True, MailDoc)
Call notesUIDoc.GOTOFIELD("Body")
Call notesUIDoc.FieldClear("Body")
Call notesUIDoc.FieldAppendText("Body", Range("B9").Value & vbCrLf & vbCrLf & Range("b10").Value & Range("I10").Value & Range("D10").Value & vbCrLf & Range("b11").Value & Range("I11").Value & Range("D11").Value & vbCrLf & Range("b12").Value & Range("I12").Value & Range("D12").Value & vbCrLf & vbCrLf & Range("b13").Value & Range("I13").Value & Range("D13").Value & vbCrLf & vbCrLf & Range("b14").Value & Range("C14").Value & Range("D14").Value & vbCrLf & vbCrLf & Range("b15").Value & Range("I15").Value & Range("D15").Value & vbCrLf & Range("F4").Value & vbCrLf)
notesUIDoc.Send
notesUIDoc.Close



    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder

    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing

End Sub

2 个答案:

答案 0 :(得分:1)

感谢大家的帮助。似乎你是正确的路径,在工作簿关闭后,似乎未触发的正常运行事件仍在计划中。我认为它们最终必须在Excel本身关闭或重新启动计算机时重置。我添加了以下似乎现在解决了这个问题的内容:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime TimeValue("12:01:00"), "Macro3", , False
    Application.OnTime TimeValue("16:00:00"), "Macro4", , False
    Application.OnTime TimeValue("20:00:00"), "Macro5", , False
    Application.OnTime TimeValue("06:00:00"), "Macro6", , False
    On Error GoTo 0
End Sub

我想我可能会在DailyAM和DailyPM子例程的末尾添加类似的代码,然后再在这些子代结束时再次调用它们。我想如果我在下午6点打开工作簿,那么下午4点准时活动也会在第二天结束两次。

再次感谢。

答案 1 :(得分:0)

看起来您已使用Application.OnTime安排了一些事件,但我看不到任何禁用这些事件的代码。如果您在白天打开工作簿5次,则这些事件将在指定时间安排5次并同时触发。如果关闭工作簿以防止事件触发,您可能需要禁用事件吗?

以下是计划和取消单个活动的示例:

在MODULE中 - 创建一个变量来存储预定时间:

Public scheduleTime As Date

代码中的某个地方安排了一些代码来运行:

Sub ScheduleEvent()

    'Code to Run

    'Reschedule 1 hour from now and rerun this Sub
    scheduleTime = Now + TimeValue("01:00:00")
    Application.OnTime scheduleTime, "ScheduleEvent", , True

End Sub

在ThisWorkbook对象中关闭Excel时确保禁用事件:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On Error Resume Next
    Application.OnTime scheduleTime, "ScheduleEvent", , False
    On Error GoTo 0

End Sub