Multi-threading

[DubnerM]

Had somebody ever tried something like following?
It crashes VBA (in my case Excel). How I can make it work (if I can)?

Option Explicit
Option Base 1

Declare Function InterlockedIncrement Lib "kernel32" (lpAppend As Long) As Long
Declare Function InterlockedDecrement Lib "kernel32" (lpAppend As Long) As Long

Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, _
       ByVal dwStackSize As Long, ByVal lpStartAddress As Long, _
       ByVal lpParameter As Long, ByVal dwCreationFlags As Long, _
       ByRef lpThreadId As Long) As Long

Dim a(10) As Long, Threads(10) As Long

Function TestThread(ByVal Arg As Long) As Long
  InterlockedIncrement a(Arg)
  Application.Wait Now + TimeValue("0:00:" & Format(10 * Arg, "00"))
  InterlockedDecrement a(Arg)
End Function

Sub TestThreads()
  Dim i As Integer, done As Boolean, s As String, t As String
  
  For i = 1 To 10
    a(i) = 0
    Threads(i) = CreateThread(0, 0, AddressOf TestThread, i, 0, 0)
  Next i
  DoEvents
  Do
    done = True
    s = ""
    For i = 1 To 10
      If i > 1 Then s = s & ", "
      t = "Stopped"
      If a(i) > 0 Then
        t = CStr(a(i))
        done = False
      End If
    Next i
    DoEvents
    Application.StatusBar = s
    DoEvents
  Loop Until done
  Application.StatusBar = False
End Sub

[sig]<p>Michael Dubner<br>Brainbench MVP/HTML+JavaScript<br>

http://www.brainbench.com<br>

[/sig]