Question

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

我将sMsgBox放置在脚本的不同点上，以查看延迟的来源，并且整个脚本在大约4到5秒钟内执行，但是当在Task Manager中观察活动进程时，我可以看到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）来创建多个对象而无需处理它们。这可能会导致您遇到延迟。

此外，脚本仅使用全局变量（在Function或Sub外部声明），并且在重置或销毁VBScript之前，这些变量不会超出范围（获取“ Garbage Collected”）。
因此，我重新编写了您的代码，以便所有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工作簿和应用程序的有效关闭

1 个答案: