VBScript - Excel 工作簿和应用程序的有效关闭

Question

我正在我们的 ERP 中运行 VBS 宏，它打开目标 Excel 文档并使用工作簿中的数据填充表单。该程序可以运行，但执行时间大约为 1 分半钟。

我将 sMsgBox 放置在脚本中的不同点以查看延迟来自何处，整个脚本在大约 4 到 5 秒内执行，但是在任务管理器中查看活动进程时，我可以看到 Execl 保持打开状态大约 1 分半钟，当它关闭时，ERP 应用程序会刷新并填充数据。脚本如下

Dim WshShell 
Set WshShell = CreateObject("WScript.Shell")


Dim yr
yr = InputBox("Please enter the payroll year")


Dim wk
wk = InputBox("Please enter the payroll week")


Dim path
path = "K:\Accounting\Payroll\JE\" & yr & "\Hourly\WK " & wk & "\RZU Payroll Template.xlsx"


Function FileExists(FilePath)
     Set fso = CreateObject("Scripting.FileSystemObject")
     If fso.FileExists(FilePath) Then
          FileExists=CBool(1)
     Else
          FileExists=Cbool(0)
     End If
End Function


If FileExists(path) Then
     Dim objExcel, objWorkbook, objSheet
     Set objExcel = CreateObject("Excel.Application")
     Set objWorkbook = objExcel.Workbooks.Open(path)
     Set objSheet = objExcel.ActiveWorkbook.Worksheets(3)


     Dim row
     row = 3


     Do While row <=28 
          val1 = objSheet.Cells(row,2).value
          val2 = objSheet.Cells(row,4).value
          val3 = objSheet.Cells(row,5).value
          WshShell.SendKeys "{INSERT}"
          WshShell.SendKeys val1
          WshShell.SendKeys "{TAB}"
          WshShell.SendKeys val2
          WshShell.SendKeys "{TAB}"
          WshShell.SendKeys val3
          row = row + 1
     Loop


     objExcel.ActiveWorkbook.Close
     objExcel.Workbooks.Close
     objExcel.Application.Quit
     Set objExcel = Nothing
Else
     MsgBox("Your entries resulted in an invalid File Path.  Please check the file location and try again")
End If

MsgBox(val1)

我相信我使用无效代码来关闭 Excel 文件，我希望应用程序在命令执行后立即关闭，但似乎并非如此。

任何帮助将不胜感激

Answer 1

您可以通过将它们设置为 Nothing（如 fso、WshShell、objWorkbook 和 objSheet）来创建多个对象而不释放它们。 这可能会导致您遇到的延迟。

此外，脚本仅使用全局变量（在函数或子函数之外声明），并且这些变量在 VBScript 被重置或销毁之前不会超出范围（获取“垃圾收集”）。
出于这个原因，我重新编写了您的代码，以便 Excel 中的所有内容都在辅助函数中完成。

Option Explicit

Dim yr, wk, path, lastInsertedValue
yr = InputBox("Please enter the payroll year")
wk = InputBox("Please enter the payroll week")
path = "K:\Accounting\Payroll\JE\" & yr & "\Hourly\WK " & wk & "\RZU Payroll Template.xlsx"

Dim WshShell, fso
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(path) Then
    lastInsertedValue = Do_ExcelStuff(path)
    'you may check this lastInsertedValue if you like:
    'MsgBox(lastInsertedValue)
Else
    MsgBox("Your entries resulted in an invalid File Path.  Please check the file location and try again")
End If

'clean up objects
Set fso = Nothing
Set WshShell = Nothing


Function Do_ExcelStuff(ByVal path)
    'Helper function to do all Excel work using variables local to the function.
    'This means they go out of scope when the function ends and should be freed immediately.
    Dim objExcel, objWorkbook, objSheet, row, val1, val2, val3

    Set objExcel = CreateObject("Excel.Application")
    objExcel.DisplayAlerts = False

    Set objWorkbook = objExcel.Workbooks.Open(path)
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(3)

    row = 3
    Do While row <= 28 
        val1 = objSheet.Cells(row,2).value
        val2 = objSheet.Cells(row,4).value
        val3 = objSheet.Cells(row,5).value
        WshShell.SendKeys "{INSERT}"
        WshShell.SendKeys val1
        WshShell.SendKeys "{TAB}"
        WshShell.SendKeys val2
        WshShell.SendKeys "{TAB}"
        WshShell.SendKeys val3
        row = row + 1
    Loop

    objExcel.ActiveWorkbook.Close
    objExcel.Workbooks.Close
    objExcel.Quit
    'clean up objects
    Set objWorkbook = Nothing
    Set objSheet = Nothing
    Set objExcel = Nothing

    'return the last value inserted to prove the code did something
    Do_ExcelStuff = val1
End Function

附： 摆脱 Excel 进程的一种非常粗略的方法是在最后一个
Set WshShell = Nothing 语句之后立即终止它。
这可能会导致数据丢失，风险全在你自己身上，但如果你想知道如何做到这一点，这里有一个小帮助函数供你使用：

Function KillExcel()
   On Error Resume Next

   Dim objWMIService, colProcess
   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}" & "!\\.\root\cimv2")

   Set colProcess = objWMIService.ExecQuery ("Select * From Win32_Process",,48)
   For Each objProcess in colProcess
      If LCase(objProcess.Name) = "excel.exe" Then
         objWshShell.Run "TASKKILL /F /T /IM " & objProcess.Name, 0, False
         objProcess.Terminate()
      End If
   Next
End Function