由shell打开的工作簿不会关闭。我该如何进一步调试?

时间:2017-09-13 06:37:42

标签: excel-vba cmd vba excel

我有一个批处理作业打开过夜的应用程序。 Workbook_Open事件使用此代码触发要更新的一系列其他工作簿:

arrUpdateList = Array(DOWNLOAD_A, _
                      TRDUPDATE, _
                      CITUPDATE, _
                      FVUPDATE, _
                      FSUPDATE)

ThisWorkbook.Worksheets("Start").Activate

For i = LBound(arrUpdateList) To UBound(arrUpdateList)
    Call UpdateItem(arrUpdateList(i))
    Stop
Next i

注意:数组中的变量只是excel文档的文件路径。

大约一周前该过程被挂起,因为打开的第一个工作簿不再关闭。第一个工作簿(DOWNLOAD_A)在其Workbook_Open事件中包含以下代码,如果我手动打开该文件,则可以正常工作。

Private Sub Workbook_Open()

    Call DownloadFileAPI

    DoEvents

    Application.DisplayAlerts = False
    Application.Quit

End Sub

如何解决此问题?我只能将问题缩小到这样一个事实,即某种方式excel不会关闭工作簿,因为它要么进入无限循环,要么调用应用程序以某种方式失去引用。 我可以做些什么来进一步调试?

为了完整起见,这里是调用工作簿中的代码(由batchjob调用以启动进程的代码):

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadID As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
   hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
   lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
   lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
   lpStartupInfo As STARTUPINFO, lpProcessInformation As _
   PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
   (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Public Function ExecCmd(cmdline$)

Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret&

   ' Initialize the STARTUPINFO structure:
   start.cb = Len(start)

   ' Start the shelled application:
   ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
      NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)

   'Shelled application needs to have an applicatin.quit command to close itself

   ' Wait for the shelled application to finish:
      ret& = WaitForSingleObject(proc.hProcess, INFINITE)
      Call GetExitCodeProcess(proc.hProcess, ret&)
      Call CloseHandle(proc.hThread)
      Call CloseHandle(proc.hProcess)
      ExecCmd = ret&

End Function

根据要求,其他相关程序: Public Sub UpdateItem(ByVal sItem As String) Dim arr As Variant Dim retval As Long Dim CurrentDay As String

CurrentDay = DateValue(Now()) & " "

'Arr is split to check if there is a time value transferred
arr = Split(sItem, "|")

    If UBound(arr) > 0 Then
        'CDate converts the date time into a date; then if the time of the same day has already
        'expired, there will be no wait. If the date time is still to come, the process will wait
        Application.Wait CDate(CurrentDay & arr(1))
    End If

    'Log start
    Call Writelog("Start: " & arr(0))

        'Start process with shellwait (what if error occurs?)
        retval = ExecCmd("excel.exe " & arr(0))

        DoEvents

    'Log end
    Call Writelog("End: " & arr(0))

Erase arr

End Sub

1 个答案:

答案 0 :(得分:0)

问题是由加载项引起的(汤森路透EIKON)。它只能通过从Excel中完全删除COM加载项来解决。

我能够和同事一起解决这个问题。关于如何进一步调试这个问题的问题可能是最好的答案。

我会对它进行一次尝试,然后说,我应该继续剥离其他代码,这些代码也运行在excel上,直到达到一个完全prestine的Excel版本。