1
votes

I have an application that is opened overnight by a batch job. The Workbook_Open event triggers a series of other workbooks to be updated using this code:

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

Note: the variables in the array are simply file paths to excel documents.

Since approx. a week ago the process gets hung up because the first workbook that is opened doesn't close itself anymore. The first workbook (DOWNLOAD_A) contains the following code in its Workbook_Open event, which if i open the file manually, works perfectly.

Private Sub Workbook_Open()

    Call DownloadFileAPI
    
    DoEvents
    
    Application.DisplayAlerts = False
    Application.Quit

End Sub

How can I fix this problem? I have only been able to narrow the problem down to the fact that somehow excel doesn't close the workbook, because it either goes into an infinite loop, or the calling application somehow looses the reference. What can I do to further debug this?

For completeness's sake, here is the code in the calling workbook (the one being called up by the batchjob to kick off the process):

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

As requested the other relevant procedures:

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
We really won't be able to give much help if you don't include in the question the two procedures (UpdateItem and DownloadFileAPI) that you say you believe are the likely culprits causing the problem. - YowE3K
And is the use of DOWNLOAD_A in the question, and DOWLOAD_A in the code a typo? - YowE3K
DONWLOAD_A was a typo. I didn't want to use the actual names as they were to telling. I will add UpdateItem so you can see the code. DownloadFileAPI though is simply the procedure that it needs to execute. I have checked that the procedure finishes the way it should, which is why I didn't include it here, so as not to cluter up the question. - rohrl77
Add a msgbox after Call DownloadFileApi and open the sheet. See if the msgbox pop's up - Moacir
@Moacir I have added a MsgBox. It poped up fine. I then tested adding two more MsgBox in the same workbook after each step and saw that in fact the called workbook closes! I then attempted adding one in the calling workbook directly after UpdateItem and that didn't show up. - rohrl77

1 Answers

0
votes

The problem was caused by an add-in (Thomson Reuters EIKON). It could only be resolved by completely removing the COM add-in from Excel.

I was able to resolved the issue together with a colleague. The question of how I could have further debugged this is probably best answered remains.

I'll take a stab at it though, and say, I should have continued to strip away other code that also ran ontop of excel, until reaching a completely prestine Excel Version.