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将启动两次。

application.OnTime TimeValue（＆＃34; hh：mm：ss＆＃34;）两次触发我的宏

1 个答案: