application.OnTime TimeValue（“hh：mm：ss”）触发我的宏两次

Question

我提取数据，修改这些数据然后通过电子邮件发送它们。

application.OnTime TimeValue("hh:mm:ss")触发我的宏两次，这意味着我收到2个电子邮件之后。

我添加了多个application.OnTime行，每30分钟发送一次该电子邮件。

下面是整个代码：

Sub scheduler() 
    application.OnTime TimeValue("14:10:31"), "myMacro" 
    application.OnTime TimeValue("14:31:01"), "ddd" 
End Sub 

Sub ddd() 
    application.OnTime TimeValue("14:31:31"), "myMacro" 
    application.OnTime TimeValue("15:01:01"), "eee" 
End Sub 

Sub eee() 
    application.OnTime TimeValue("15:01:31"), "myMacro" 
    application.OnTime TimeValue("15:31:01"), "fff" 
End Sub 

Sub fff() 
    application.OnTime TimeValue("15:31:31"), "myMacro" 
    application.OnTime TimeValue("16:01:01"), "ggg" 
End Sub 

Sub ggg() 
    application.OnTime TimeValue("16:01:31"), "myMacro" 
    application.OnTime TimeValue("16:31:01"), "hhh" 
End Sub 

Sub hhh() 
    application.OnTime TimeValue("16:31:31"), "myMacro" 
    application.OnTime TimeValue("17:01:01"), "iii" 
End Sub 

Sub iii() 
    application.OnTime TimeValue("17:01:31"), "myMacro" 
    application.OnTime TimeValue("17:31:01"), "jjj" 
End Sub 

Sub jjj() 
    application.OnTime TimeValue("17:31:31"), "myMacro" 
    application.OnTime TimeValue("18:01:01"), "kkk" 
End Sub 

Sub kkk() 
    application.OnTime TimeValue("18:01:31"), "myMacro" 
    application.OnTime TimeValue("18:31:01"), "lll" 
End Sub 

Sub lll() 
    application.OnTime TimeValue("18:31:31"), "myMacro" 
    application.OnTime TimeValue("19:01:01"), "mmm" 
End Sub 

Sub mmm() 
    application.OnTime TimeValue("19:01:31"), "myMacro" 
    application.OnTime TimeValue("19:31:01"), "nnn" 
End Sub 

Sub nnn() 
    application.OnTime TimeValue("19:31:31"), "myMacro" 
    application.OnTime TimeValue("20:01:01"), "ooo" 
End Sub 

Sub ooo() 
    application.OnTime TimeValue("20:01:31"), "myMacro" 
    application.OnTime TimeValue("20:31:01"), "ppp" 
End Sub 

Sub ppp() 
    application.OnTime TimeValue("20:31:31"), "myMacro" 
    application.OnTime TimeValue("21:01:01"), "qqq" 
End Sub 

Sub qqq() 
    application.OnTime TimeValue("21:01:31"), "myMacro" 
    application.OnTime TimeValue("21:31:01"), "rrr" 
End Sub 

Sub rrr() 
    application.OnTime TimeValue("21:31:31"), "myMacro" 
    application.OnTime TimeValue("22:01:01"), "sss" 
End Sub 

Sub sss() 
    application.OnTime TimeValue("22:01:31"), "myMacro" 
    application.OnTime TimeValue("22:31:01"), "ttt" 
End Sub 

Sub ttt() 
    application.OnTime TimeValue("22:31:31"), "myMacro" 
    application.OnTime TimeValue("23:01:01"), "uuu" 
End Sub 

Sub uuu() 
    application.OnTime TimeValue("23:01:31"), "myMacro" 
    application.OnTime TimeValue("23:31:01"), "vvv" 
End Sub 

Sub vvv() 
    application.OnTime TimeValue("23:31:31"), "myMacro" 
    application.OnTime TimeValue("23:57:01"), "www" 
End Sub 

Sub www() 
    application.OnTime TimeValue("23:57:31"), "myMacro" 
    application.OnTime TimeValue("23:59:01"), "scheduler" 
End Sub 

Sub myMacro() 
    Dim path As String 
    Dim site As String 

    path = "chrome's path" 
    site = "https://mysite" 

    Shell (path & site) 
    application.Wait (Now + TimeValue("00:00:10")) 

    Const SOME_PATH As String = "downloaded file path" 
    Dim file As String 
    file = Dir$(SOME_PATH & "JHGK_Responses*" & ".xlsx") 

    application.Wait (Now + TimeValue("0:00:05")) 

    If (Len(file) > 0) Then 
     Workbooks.Open(SOME_PATH & file).Activate 
    End If 

    application.Wait (Now + TimeValue("0:00:02")) 
    ActiveSheet.Range("A4:BC600").Copy 
    Windows("my macro's sheet.xlsm").Activate 
    Range("A3").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    [L:L].Select 
    With Selection 
     .NumberFormat = "General" 
     .Value = .Value 
    End With 
    Range("A3").Select 

    application.CutCopyMode = False 
    application.Wait (Now + TimeValue("0:00:50")) 
    Workbooks(file).Activate 
    application.Wait (Now + TimeValue("0:00:03")) 
    ActiveWorkbook.Close savechanges:=False 

    With New FileSystemObject 
     If .FileExists(SOME_PATH & file) Then 
      .DeleteFile SOME_PATH & file 
     End If 
    End With 

    Windows("my marco's sheet.xlsm").Activate 
    Worksheets("Pivots").Activate 
    ThisWorkbook.RefreshAll 
    application.Wait (Now + TimeValue("0:00:03")) 
    Worksheets("Email").Activate 
    application.Wait (Now + TimeValue("0:00:03")) 

    Dim EmailSubject As String 
    Dim SendTo As String 
    Dim EmailBody As String 
    Dim ccTo As String 
    Dim r As Range 
    Set r = Sheets("Email").Range("A1:E72") 

    r.Copy 

    EmailSubject = "whatever at " & Format(Time, "hh:mm") 
    SendTo = Range("Q10") 
    ccTo = Range("Q10") 

    Dim outlookApp As Outlook.application 
    Set outlookApp = CreateObject("outlook.Application") 
    Dim outMail As Outlook.MailItem 
    Set outMail = Outlook.CreateItem(olMailItem) 

    With outMail 
     .Subject = EmailSubject 
     .SentOnBehalfOfName = "mailboxname" 
     .To = SendTo 
     .CC = ccTo 
     .body = EmailBody 
     .display 

     outMail.display 
     Dim wordDoc As Word.Document 
     Set wordDoc = outMail.GetInspector.WordEditor 

     'Paste as Picture 
     'wordDoc.Range.PasteAndFormat wdChartPicture 

     'paste as Table (remove the comma) 
     wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False 
     .send 
    End With 
    Set outlookApp = Nothing 
    Set outMail = Nothing 

    Windows("my macro's sheet.xlsm").Activate 
    Sheets("Raw").Select 
    Range("A3:BC900").Select 
    Selection.ClearContents 
    Range("A3").Select 
End Sub 

我有这么多的潜艇使用application.OnTime方法那么其他线路来触发下一子从去倒数第二次循环触发myMacro开始。

由于我的公司安全策略，Windows任务计划程序不是一个选项。

Answer 1

您很可能在同一个Excel会话中两次调用scheduler，例如，同时调试。重新启动Excel并确保scheduler仅被调用一次。

有趣的事实：如果您致电scheduler，则在保持Excel打开的同时关闭工作簿，Excel将在计划的时间重新打开工作簿并运行宏。如果在此期间，您已经手动打开了工作簿并调用了scheduler，则myMacro将启动两次。