从计时器

时间:2016-06-25 19:58:07

标签: vba vbscript task scheduler

我有一个从互联网下载一些信息的宏,我需要安排它从一天中的特定时间开始自动运行并以设定的时间间隔重复运行,尽管偶尔会在宏输出的特定时间运行。

我已经从两个方面解决了这个问题,这两个方面都存在我无法解决的问题。第一种方法是使用一个使用Application.OnTime命令运行宏的计时器子,其中运行时派生自工作簿中由宏更新的单元格。

如果我在计算机上做其他事情,这种方法效果很好。但是,我注意到,如果我离开,即使计算机没有进入睡眠状态,程序也会在30分钟左右后不可避免地停止重新运行。有时,即使我在计算机上处​​于活动状态,它也会停止重新运行。为什么是这样?可能是什么导致了这个?此外,当然,我无法安排程序在宏内自动打开和运行,所以我转向VBScript&这部分解决方案的任务计划程序方法。

但是,我遇到了执行VBScript的两个问题。首先,它是由Task Scheduler运行时经常无法启动的。其次,当它运行时,宏中的Application.OnTime命令不起作用。这是一个问题,因为宏需要以不规则的时间间隔运行,这些时间间隔是在宏观运行其迭代时在一天中确定的。为什么在任务管理器尝试时vbscript无法运行,为什么它不会像我手动运行宏时那样启动application.ontime命令?

VBA定时器代码:

Sub Timer()
    Dim Runtime As Date

    If Time <= TimeValue("17:45:00") Then
        Workbooks("10am_Swing_Report").Sheets("Parameters").Cells(17, 2).Value = 10
    ElseIf Time > TimeValue("17:45:00") And Time <= TimeValue("18:15:00") Then
        Workbooks("10am_Swing_Report").Sheets("Parameters").Cells(17, 2).Value = 13
    ElseIf Time > TimeValue("18:15:00") And Time <= TimeValue("18:45:00") Then
        Workbooks("10am_Swing_Report").Sheets("Parameters").Cells(17, 2).Value = 16
    ElseIf Time > TimeValue("18:45:00") And Time <= TimeValue("19:15:00") Then
        Workbooks("10am_Swing_Report").Sheets("Parameters").Cells(17, 2).Value = 19
    End If

    Workbooks("10am_Swing_Report").Sheets("Parameters").Range("B16").Calculate
    If Time > Workbooks("10am_Swing_Report").Sheets("Parameters").Range("B16").Value Then
        Runtime = Time + TimeValue("00:00:30")
    Else
        Runtime = Workbooks("10am_Swing_Report").Sheets("Parameters").Range("B16").Value
    End If

    Application.OnTime TimeValue(Runtime), "Swingtimer"

    Workbooks("10am_Swing_Report").Sheets("Parameters").Range("C16").Value = Runtime
    Workbooks("10am_Swing_Report").Save
End Sub

谢谢!

我已更新Vbs代码以包含已通过运行时的验证,但我仍然遇到任务计划程序无法启动任务的问题。我收到以下错误:&#34;启动请求被忽略,实例已经运行&#34;接下来是:&#34;任务开始失败&#34;。我原本以为这是因为Vbscript仍然从前一个实例运行,但我从一开始就得到了这个。

Option Explicit


Dim xlApp       
Dim xlBook      
Dim runtime 
Dim xlSheet



Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
'xlApp.Application.DisplayAlerts = True
Set xlBook = xlApp.Workbooks.Open("C:\Users\DORIAN\Dropbox\Swing_Report.xlsm",1,False)
Set xlSheet = xlBook.Sheets("Parameters")

'xlBook.application.Visible = True

'MsgBox FormatDateTime(xlSheet.Range("B16").Value,3)
runtime = TimeValue(FormatDateTime(xlSheet.Range("B16").Value,3))
'MsgBox runtime


If Time > runtime Then 
    xlApp.Run "Swingtimer"
    'MsgBox "Running..."
    WScript.Sleep 30000
Else
xlApp.Application.OnTime runtime, "Swingtimer"
'MsgBox "Timer Set"
End If


xlbook.close True

WScript.Quit

2 个答案:

答案 0 :(得分:0)

你能以不同的方式做到吗? 1) 在Windows Scheduler中运行vbscript,每隔1分钟或1小时或... ...

2) 在VBscript中加入一些验证 如果条件那么     执行你的代码 其他     停止vbscript 如果

结束

使用它你可能会摆脱OnTime事件处理程序

祝你好运 亚历

答案 1 :(得分:0)

我认为你过于复杂化了。您只需要一个Workbook_Open事件和Windows任务计划程序。

像这样的东西(根据您的需要定制)。

Private Sub Workbook_Open()
    Msgbox Date
    Worksheets("Sheet1").Range("A1").Value = Date
End Sub

使用Windows任务计划程序安排事件。

http://www.sevenforums.com/tutorials/11949-elevated-program-shortcut-without-uac-prompt-create.html