On Error Resume Next
 
  Dim XLS As Object, thisWindow As Object
 
  ' Zugriff auf EXCEL (EXCEL muss bereits gestartet sein!)
  Set XLS = GetObject(, "Excel.Application")
  If XLS Is Nothing Then
    MsgBox "Keine aktive EXCEL-Arbeitsmappe gefunden." & vbNewLine & _
      "EXCEL ist nicht gestartet." & IIf(Error <> "", _
      vbNewLine & vbNewLine & "Fehlerbeschreibung: " & Error, ""), _
      vbExclamation
    Exit Sub
  End If
 
  ' Zugriff aus die aktive Arbeitsmappe
  Set thisWindow = XLS.ActiveWorkbook
  If thisWindow Is Nothing Then
    MsgBox "Keine aktive EXCEL-Arbeitsmappe gefunden." & vbNewLine & _
      "Im Excel ist keine Arbeitsmappe sichtbar." & IIf(Error <> "", _
      vbNewLine & vbNewLine & "Fehlerbeschreibung: " & Error, ""), _
      vbExclamation
    Exit Sub
  End If
 
  'Set fft = thisWindow.Worksheets("fft")
  'Set uebertrag = thisWindow.Worksheets("Uebertrag")
 
 
  MsgBox "Aktive Arbeitsmappe: " & thisWindow.Name & vbNewLine & _
    "Aktives Blatt: " & thisWindow.ActiveSheet.Name
 
  'Set uebertrag = Nothing
  'Set fft = Nothing
 
  Set thisWindow = Nothing
  Set XLS = Nothing

Viel Spass,
R@lf