VBScript - Эффективное закрытие книги и приложения Excel - PullRequest
0 голосов
/ 30 мая 2019

Я запускаю макрос VBS в нашей ERP, который открывает целевой документ Excel и заполняет форму данными из рабочей книги.Программа работает, но время ее выполнения составляет примерно полторы минуты.

Я поместил sMsgBox в разные точки сценария, чтобы увидеть, откуда происходит задержка, и весь сценарий выполняется примерно за 4-5 секунд., но при просмотре активных процессов в диспетчере задач я вижу, что Execl остается открытым в течение примерно полутора минут, а когда он закрывается, приложение 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, я ожидал бы, что приложение закроется, как только команда будет выполнена, но это не так.

Любая помощь будет принята с благодарностью

1 Ответ

0 голосов
/ 31 мая 2019

Вы создаете несколько объектов, не выбрасывая их, устанавливая для них значение Ничего, например 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...