首页 文章

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

提问于
浏览
0

我有一个应用程序,通过批处理作业打开过夜 . 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文档的文件路径 .

大约一周前 the process gets hung up because the first workbook that is opened doesn't close itself anymore . 第一个工作簿(DOWNLOAD_A)在其Workbook_Open事件中包含以下代码,如果我手动打开该文件,则可以正常工作 .

Private Sub Workbook_Open()

    Call DownloadFileAPI

    DoEvents

    Application.DisplayAlerts = False
    Application.Quit

End Sub

我该如何解决这个问题?我只能将问题缩小到以下事实:某种方式excel不会关闭工作簿,因为它要么进入无限循环,要么调用应用程序以某种方式丢失引用 . What can I do to further debug this?

为了完整起见,这里是调用工作簿中的代码(由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

结束子

1 回答

  • 0

    问题是由加载项引起的(Thomson Reuters EIKON) . 它只能通过从Excel中完全删除COM加载项来解决 .

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

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

相关问题