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

我有这么多 subs 来触发 myMacro 使用 application.OnTime 方法然后另一行触发下一个 sub 到倒数第二个 sub 从头开始​​循环。

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

Answer 1

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

有趣的事实：如果您调用scheduler，然后关闭工作簿，同时保持 Excel 处于打开状态，Excel 将在预定时间重新打开工作簿并运行宏。如果在此期间您手动打开了工作簿并调用了scheduler，myMacro 将启动两次。