使用.bat文件和任务计划程序执行.vbs文件

时间：2019-04-04 15:06:26

标签： excel vba windows scheduled-tasks

我的以下代码正常运行。

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完全陌生。

2 个答案:

答案 0 :(得分：2)

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

首先，您在Workbook_Open()中设置功能：

Private Sub Workbook_Open()
   Call StandardizationReferralReports
End Sub

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

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

enter image description here

  1. 您按照Microsoft Official Documentation
    2. 使用VBA Macro自动 创建任务例程

这是您可以用来启动的示例代码：

 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

答案 1 :(得分：1)

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

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
相关问题
最新问题