Вы создаете несколько объектов, не выбрасывая их, устанавливая для них значение Ничего, например fso
, WshShell
, objWorkbook
и objSheet
.Это может привести к задержке, которую вы испытываете.
Кроме того, сценарий использует только глобальные переменные (объявленные вне функции или подпрограммы), и эти переменные не выходят за пределы области видимости (получают "Garbage Collected") до тех пор, пока 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
PS Очень грубый способ избавиться от процесса 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