从计时器通过 vbscript 自动运行宏

Question

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

我用两种方法解决了这个问题，这两种方法都提出了我无法弄清楚的问题。第一种方法是使用计时器子程序，该子程序使用 Application.OnTime 命令运行宏，运行时从工作簿中由宏更新的单元格派生。

如果我在电脑上做其他事情，这种方法效果很好。但是，我注意到，如果我离开，即使计算机没有进入睡眠状态，程序不可避免地会在 30 分钟左右后停止重新运行。有时即使我在计算机上处​​于活动状态，它也会停止重新运行。为什么是这样？这可能是什么原因造成的？此外，自然地，我无法安排程序在宏内自动打开和运行，因此我转向了 VBScript & Task Scheduler 方法来解决这部分问题。

然而，我在执行 VBScript 时遇到了两个问题。首先，它在任务计划程序运行时经常无法启动。其次，当它运行时，宏中的 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 代码以包含运行时已通过的验证，但我仍然遇到任务计划程序无法启动任务的问题。我收到以下错误：“已忽略启动请求，实例已在运行”，然后是：“任务启动失败”。我最初认为这是因为 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

Answer 1

你能用不同的方式来做吗？ 1) 在 Windows 调度程序中运行 vbscript，比如每 1 分钟或 1 小时或……。

2) 在 VBscript 中进行一些验证
如果条件那么 执行你的代码 别的 停止 vbscript 结束如果

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

最好的问候 亚历克斯

Answer 2

我认为你把事情复杂化了。您只需要一个 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