使用 .bat 文件和任务调度程序执行 .vbs 文件 [重复]

Question

我的以下代码运行正常。

1.) 谁能帮我知道如何使用任务调度程序来安排这个 VBS 文件？

2.) 我也想了解编写 .bat 文件以执行此脚本。

请看下面的代码：

    Macro1
Private Sub Macro1()
Set objExcel  = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\kursekar\Documents\Work\Dailytasks\January\ReferralStrApp\StdztnRefRepTrial.xlsx")
objExcel.Visible = True
Dim Conn
Dim RS
Dim SQL
SQL = "WITH cte_REFERRALS_REPORTS(referralnum, refer_from, refer_from_name, refer_from_id, refer_to, refer_to_name, refer_to_id) AS (SELECT referralnum, refer_from, CASE WHEN refer_from_id = 'R' THEN RdicF.refname WHEN refer_from_id = 'P' THEN PdicF.provname END AS refer_from_name, refer_from_id, refer_to, "
SQL = SQL & "CASE WHEN refer_to_id = 'R' THEN RdicT.refname WHEN refer_to_id = 'P' THEN PdicT.provname END AS refer_to_name, refer_to_id FROM referral_t r Left Join refcode_t RdicF ON  r.refer_from = CASE WHEN r.refer_from_id='R' THEN RdicF.refcode ELSE NULL END Left Join refcode_t RdicT ON  r.refer_to = CASE WHEN r.refer_to_id = 'R' THEN RdicT.refcode ELSE NULL END "
SQL = SQL & "Left Join provcode_t PdicF ON r.refer_from  = CASE WHEN r.refer_from_id = 'P' THEN PdicF.provcode ELSE NULL END Left Join provcode_t PdicT ON r.refer_to = CASE WHEN r.refer_to_id = 'P' THEN PdicT.provcode ELSE NULL END ) SELECT chgslipno , a.acctno, patfname, patlname, appt_date, a.enccode, pr.provname "
SQL = SQL & ",a.provcode, rfc.refname, a.refcode, r1.refer_from as r1_ref_from, r1.refer_from_id as r1_ref_from_id, r1.refer_from_name as r1_ref_from_name, a.referral1 as r1_refnum, r2.refer_from as r2_ref_from, r2.refer_from_id as r2_ref_from_id, r2.refer_from_name as r2_ref_from_name,a.referral2, prgrc.provgrpdesc,s.specdesc, a.prov_dept, pos.posdesc,pr.cred "
SQL = SQL & "FROM apptmt_t a Left JOIN patdemo_t p ON a.acctno = p.acctno LEFT JOIN provcode_t pr ON pr.provcode = a.provcode LEFT JOIN refcode_t rfc ON a.refcode = rfc.refcode LEFT JOIN (SELECT*FROM cte_REFERRALS_REPORTS) r1 ON a.referral1 = r1.referralnum LEFT JOIN (SELECT*FROM cte_REFERRALS_REPORTS) r2 "
SQL = SQL & "on a.referral2 = r2.referralnum LEFT JOIN provgrpprov_t prgrpr on a.provcode = prgrpr.provcode LEFT JOIN provgrpcode_t prgrc on prgrpr.provgrpcode = prgrc.provgrpcode LEFT JOIN specialty_t s on pr.speccode = s.speccode LEFT JOIN poscode_t pos on a.poscode = pos.poscode "
SQL = SQL & "WHERE UPPER(a.enccode) in ('CON','APE','COB','CONZ','HAC','HFUI','MMN','NCG','NCHF','NCPF','NHFU','NMC','NOB','NP','NP15','NPE','NPI','NPOV','NPS','NPSV','NPV','OVN','IMC','NP30') AND UPPER(a.appt_status)='ARR' AND appt_date >= '2017-01-01' "
SQL = SQL & "ORDER BY a.acctno"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open = "Provider=SQLOLEDB.1;Password='25LaurelRoad';User ID='CPSMDIT\kursekar';Data Source='analyzer';Initial Catalog='analyzer_str';Integrated Security=SSPI; Persist Security Info=True;"
Set RS = Conn.Execute(SQL)
Set Sheet = objWorkbook.ActiveSheet
Sheet.Activate
Dim R
R = 2
While RS.EOF = False
  Sheet.Cells(R, 1).Value = RS.Fields(0)
  Sheet.Cells(R, 2).Value = RS.Fields(1)
  Sheet.Cells(R, 3).Value = RS.Fields(2)
  Sheet.Cells(R, 4).Value = RS.Fields(3)
  Sheet.Cells(R, 5).Value = RS.Fields(4)
  Sheet.Cells(R, 6).Value = RS.Fields(5)
  Sheet.Cells(R, 7).Value = RS.Fields(6)
  Sheet.Cells(R, 8).Value = RS.Fields(7)
  Sheet.Cells(R, 9).Value = RS.Fields(8)
  Sheet.Cells(R, 10).Value = RS.Fields(9)
  Sheet.Cells(R, 11).Value = RS.Fields(10)
  Sheet.Cells(R, 12).Value = RS.Fields(11)
  Sheet.Cells(R, 13).Value = RS.Fields(12)
  Sheet.Cells(R, 14).Value = RS.Fields(13)
  Sheet.Cells(R, 15).Value = RS.Fields(14)
  Sheet.Cells(R, 16).Value = RS.Fields(15)
  Sheet.Cells(R, 17).Value = RS.Fields(16)
  Sheet.Cells(R, 18).Value = RS.Fields(17)
  Sheet.Cells(R, 19).Value = RS.Fields(18)
  Sheet.Cells(R, 20).Value = RS.Fields(19)
  Sheet.Cells(R, 21).Value = RS.Fields(20)
  Sheet.Cells(R, 22).Value = RS.Fields(21)
  Sheet.Cells(R, 23).Value = RS.Fields(22)
  RS.MoveNext
  R = R + 1
Wend
RS.Close
Conn.Close
Application.DisplayAlerts = False
'Release memory
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
ActiveWorkbook.Save
'objWorkbook.SaveAs Filename:="C:\\Users\kursekar\Documents\Work\Dailytasks\January\ReferralStrApp\StdztnRefRepTrial.xlsx", FileFormat:=51
Application.DisplayAlerts = True
objWorkbook.Close
objExcel.Workbooks.Close
objExcel.Quit
Workbooks.Close
Set objExcel = Nothing
MsgBox ("Saved")
End Sub

谢谢你们！请随时输入。我对 VB 完全陌生。

Answer 1

您必须遵循几个步骤来实现您的目标。

首先，在Workbook_Open() 中设置函数：

Private Sub Workbook_Open()
   Call StandardizationReferralReports
End Sub

然后您创建一个任务计划程序，在特定的给定时间打开您的 Excel 文件。 您有两种方法可以做到这一点：

1. 您手动在 Windows Task Scheduler 中创建一个新的 Task。您可以通过以下方式打开它：
   • Win + R -> taskschd.msc

1. 您使用VBA Macro自动创建一个任务例程，遵循Microsoft Official Documentation

这里有一个示例代码，您可以使用它来开始：

 Sub createTask()
    '------------------------------------------------------------------
    ' This sample schedules a task to start notepad.exe 30 seconds
    ' from the time the task is registered.
    '------------------------------------------------------------------

    ' A constant that specifies a time-based trigger.
    Const TriggerTypeTime = 1
    ' A constant that specifies an executable action.
    Const ActionTypeExec = 0


    '********************************************************
    ' Create the TaskService object.
    Set service = CreateObject("Schedule.Service")
    Call service.Connect

    '********************************************************
    ' Get a folder to create a task definition in.
    Dim rootFolder
    Set rootFolder = service.GetFolder("\")

    ' The taskDefinition variable is the TaskDefinition object.
    Dim taskDefinition
    ' The flags parameter is 0 because it is not supported.
    Set taskDefinition = service.NewTask(0)

    '********************************************************
    ' Define information about the task.

    ' Set the registration info for the task by
    ' creating the RegistrationInfo object.
    Dim regInfo
    Set regInfo = taskDefinition.RegistrationInfo
    regInfo.Description = "Start an Excel document by a specified time."
    regInfo.Author = "Author Name"

    '********************************************************
    ' Set the principal for the task
    Dim principal
    Set principal = taskDefinition.principal

    ' Set the logon type to interactive logon
    principal.LogonType = 3


    ' Set the task setting info for the Task Scheduler by
    ' creating a TaskSettings object.
    Dim settings
    Set settings = taskDefinition.settings
    settings.Enabled = True
    settings.StartWhenAvailable = True
    settings.Hidden = False

    '********************************************************
    ' Create a time-based trigger.
    Dim triggers
    Set triggers = taskDefinition.triggers

    Dim trigger
    Set trigger = triggers.Create(TriggerTypeTime)

    ' Trigger variables that define when the trigger is active.
    Dim startTime, endTime

    Dim time
    time = DateAdd("s", 30, Now)  'start time = 30 seconds from now
    startTime = XmlTime(time)

    time = DateAdd("n", 5, Now) 'end time = 5 minutes from now
    endTime = XmlTime(time)

    WScript.Echo "startTime :" & startTime
    WScript.Echo "endTime :" & endTime

    trigger.StartBoundary = startTime
    trigger.EndBoundary = endTime
    trigger.ExecutionTimeLimit = "PT5M"    'Five minutes
    trigger.ID = "TimeTriggerId"
    trigger.Enabled = True

    '***********************************************************
    ' Create the action for the task to execute.

    ' Add an action to the task to run notepad.exe.
    Dim Action
    Set Action = taskDefinition.Actions.Create(ActionTypeExec)
    Action.Path = Chr(34) & Application.Path & "\EXCEL.EXE"" " & """C:\This\is\the\path\to your\file.xlsx"""

    WScript.Echo "Task definition created. About to submit the task..."

    '***********************************************************
    ' Register (create) the task.

    Call rootFolder.RegisterTaskDefinition( _
        "Test TimeTrigger", taskDefinition, 6, , , 3)

    WScript.Echo "Task submitted."
End Sub

'------------------------------------------------------------------
' Used to get the time for the trigger
' startBoundary and endBoundary.
' Return the time in the correct format:
' YYYY-MM-DDTHH:MM:SS.
'------------------------------------------------------------------
Function XmlTime(t)
    Dim cSecond, cMinute, CHour, cDay, cMonth, cYear
    Dim tTime, tDate

    cSecond = "0" & Second(t)
    cMinute = "0" & Minute(t)
    CHour = "0" & Hour(t)
    cDay = "0" & Day(t)
    cMonth = "0" & Month(t)
    cYear = Year(t)

    tTime = Right(CHour, 2) & ":" & Right(cMinute, 2) & _
        ":" & Right(cSecond, 2)
    tDate = cYear & "-" & Right(cMonth, 2) & "-" & Right(cDay, 2)
    XmlTime = tDate & "T" & tTime
End Function

Answer 2

我创建了一个 .vbs 文件来调用我的函数 vba，然后我在 Windows 中使用 TASK SCHEDULER，因此您无需打开您的 excel 文件，只需保持您的电脑开机，它就会自动启动

Option Explicit

On Error Resume Next

ExcelMacroExample

Sub ExcelMacroExample() 

  Dim xlApp 
  Dim xlBook 

  Set xlApp = CreateObject("Excel.Application") 
  Set xlBook = xlApp.Workbooks.Open("C:\MyWorkbook.xls", 0, True) 
  xlApp.Run "MyMacro"
  xlApp.Quit 

  Set xlBook = Nothing 
  Set xlApp = Nothing 

  End Sub 

如果您从未使用过任务计划程序，它会隐藏在您的开始菜单中的开始菜单 → Windows 管理工具中。 任务计划程序窗口的右侧是一个操作框。在该框下，单击按钮以创建基本任务...。继续命名你的任务，然后给它一个描述，如果你愿意点击下一步，然后你选择你的vbs文件，你可以给他你想运行它的日期和时间（或者你可以让他每周重复一次或每天有时间）。

.bat 文件代码

cscript c:\yourVBSFile.vbs