Option Explicit
 
' alle benötigten API's
Private Declare Function GetWindow Lib "user32" _
    (ByVal hWnd As Long, ByVal wCmd As Long) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
  Alias "GetWindowLongA" (ByVal hWnd As Long, _
  ByVal wIndx As Long) As Long
 
Private Declare Function GetWindowTextLength Lib "user32" _
  Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
 
Private Declare Function GetWindowText Lib "user32" _
  Alias "GetWindowTextA" (ByVal hWnd As Long, _
  ByVal lpString As String, ByVal cch As Long) As Long
 
Const GW_HWNDFIRST = 0
Const GW_HWNDNEXT = 2
 
Const GWL_STYLE = (-16)
 
Const WS_VISIBLE = &H10000000
Const WS_BORDER = &H800000

Private Function Word_GetTitel() As String
  ' Ermittelt den Fenstertitel, falls Word gestartet
  Dim hWnd As Long
  Dim sTitle As String
  Dim lStyle As Long
 
  ' Erstes WindowHandle holen
  hWnd = GetWindow(Me.hWnd, GW_HWNDFIRST)
 
  Do
    ' Handle auswerten
    lStyle = GetWindowLong(hWnd, GWL_STYLE)
    lStyle = lStyle And (WS_VISIBLE Or WS_BORDER)
 
    If (lStyle = (WS_VISIBLE Or WS_BORDER)) = True Then
      ' Titelzeile ermitteln und prüfen, ob
      ' das "Microsoft Word" darin enthalten ist
      sTitle = GetWindowTitle(hWnd)
      If InStr(1, sTitle, "Microsoft Word", _
        vbTextCompare) > 0 Then
        Word_GetTitel = sTitle
      End If
    End If
    ' Nächses Handle
    hWnd = GetWindow(hWnd, GW_HWNDNEXT)
  Loop Until hWnd = 0
End Function

' Hilfsfunktion
Private Function GetWindowTitle(ByVal hWnd As Long) _
  As String
 
  ' Ermittelt den Namen eines Windows anhand des
  ' Window Handle
 
  Dim lResult As Long
  Dim sTemp As String
 
  lResult = GetWindowTextLength(hWnd) + 1
  sTemp = Space(lResult)
  lResult = GetWindowText(hWnd, sTemp, lResult)
  GetWindowTitle = Left(sTemp, Len(sTemp) - 1)
End Function

Dim sTitel As String
 
sTitel = Word_GetTitel()
If sTitel <> "" Then
  MsgBox sTitel
Else
  MsgBox "Word ist nicht gestartet."
End If

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de