Excel 2021 Slow/Hanging External Child Processes (VBA)

Copper Contributor

So I'm trying to get some VBA scripts working on Windows 11, Excel 2021 after migrating from Windows 10, Excel 2016.   However my scripts that make ImageMagick run in a multi-threaded fashion no longer work properly. 

If you refer to the attached screenshot you'll see that none of the spawned child processes are active.  If you wait long enough, they'll eventually complete.  On Excel 2016, these processes would run right immediately and you'd get 100% processor usage.

 

How do I fix it so that spawned processes will run as fast as possible?

Edit: The reason I'm using the WSH.Exec is because I want to directly retrieve the returned text magick.exe.  Interestingly, the WSH.Run method doesn't seemed to affected by this issue at all.

 

This code basically shows the method of spawning a number of windows up to variable MaxProcesses

 

 

Dim wsh As Object: Set wsh = CreateObject("WScript.Shell")
Dim ShellObj() As Object, ShellOut() As Object, ActiveFile() As Integer
ReDim ShellObj(1 To MaxProcesses) As Object
ReDim ShellOut(1 To MaxProcesses) As Object
ReDim ActiveFile(1 To TotalNumFiles) As Integer

For i = 1 To MaxProcesses
    InputFile = InputFolder & "\" & Range("FileNames").Offset(i - 1, 0).Value
    CMDstring = """" & IMexe & """ " & JPEGconfig & " """ & InputFile & """"

    Set ShellObj(i) = wsh.Exec(CMDstring)
    Set ShellOut(i) = ShellObj(i).StdOut
    AttemptedExecutions = AttemptedExecutions + 1
    ActiveFile(i) = AttemptedExecutions
Next i

Dim k As Integer, ReadFiles As Integer, ImgType As String
ReadFiles = 0
While ReadFiles < TotalNumFiles
    For i = 1 To MaxProcesses
        
        If ShellObj(i).Status <> 0 Then
            k = ActiveFile(i) - 1
            While Not ShellOut(i).AtEndOfStream
                TextOut = ShellOut(i).ReadLine
                
                ReadFiles = ReadFiles + 1
            Wend
            If AttemptedExecutions < TotalNumFiles Then
                InputFile = InputFolder & "\" & Range("FileNames").Offset(AttemptedExecutions, 0).Value

                CMDstring = """" & IMexe & """ " & JPEGconfig & " """ & InputFile & """"

                Set ShellObj(i) = wsh.Exec(CMDstring)
                Set ShellOut(i) = ShellObj(i).StdOut
                AttemptedExecutions = AttemptedExecutions + 1
                ActiveFile(i) = AttemptedExecutions

            End If
        End If
               
    Next i
    
Wend

 

 

0 Replies