VBScript

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。这可能会导致您遇到延迟。

此外，该脚本仅使用全局变量（在函数或子程序外部声明），并且这些变量不会超出范围 (get "Garbage Collected")，直到 VBScript 被重置或销毁。
出于这个原因，我有 re-written 你的代码，所以一切 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

P.S。 摆脱 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

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

VBScript - Effecient Close Of Excel Workbook and Application

excel