' zunächst die benötigten API-Deklarationen
Private Declare Function SendMessage Lib "user32" Alias _
  "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
  ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function GetWindowThreadProcessId Lib _
  "user32" (ByVal hWnd As Long, lpdwProcessId As Long) _
  As Long
 
Private Declare Function FindWindow Lib "user32" _
  Alias "FindWindowA" (ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long
 
Private Declare Function GetWindow Lib "user32" _
  (ByVal hWnd As Long, ByVal wCmd As Long) As Long
 
Private Declare Function GetParent Lib "user32" _
  (ByVal hWnd As Long) As Long
 
Private Const GW_HWNDNEXT = 2
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
Const LNULL = 0&
 
Dim lnghWnd As Long
 
Private Sub cmdStart_Click()
  Dim sFileName As String
 
  sFileName = "C:\Windows\system32\calc.exe"
  Call Shell2hWnd(sFileName)
 
  MsgBox lnghWnd
End Sub
 
Private Sub cmdStop_Click()
  Dim lRet As Long
 
  If lnghWnd <> 0 Then
    ' Fenster schließen
    lRet = SendMessage(lnghWnd, WM_SYSCOMMAND, _
      SC_CLOSE, LNULL)
  End If
End Sub
 
' Anwendung starten und Fenster-Handle zurückgeben
Private Function Shell2hWnd(ByVal sFileName As String, _
  Optional ByVal Mode As VbAppWinStyle)
 
  Dim lngAppTaskID As Long
  Dim lngProcTaskID As Long
 
  ' TaskID der zu startenden Anwendung
  lngAppTaskID = Shell(sFileName, Mode)
 
  ' Anwendung konnte nicht gestartet werden
  If lngAppTaskID = 0 Then Exit Function
 
  ' Fenster durchlaufen und nach Process-ID suchen
  lnghWnd = FindWindow(vbNullString, vbNullString)
  Do While lnghWnd <> 0
 
    ' Existiert kein Eltern-Fenster, dann ProcessID
    ' ermitteln und mit TaskID vergleichen
    If GetParent(lnghWnd) = 0 Then
      GetWindowThreadProcessId lnghWnd, lngProcTaskID
 
      ' Handelt es sich um die gesuchte TaskID?
      If lngProcTaskID = lngAppTaskID Then
        ' Fenster-Handle zurückgeben und Schleife
        ' verlassen!
        Shell2hWnd = lnghWnd
        Exit Do
      End If
 
    End If
 
    ' Nächstes Fenster
    lnghWnd = GetWindow(lnghWnd, GW_HWNDNEXT)
  Loop
End Function