Da hilt gar nicht ....
08.10.2009 21:23:30
Ramses
Hallo
du musst schon die andere Instanz einem Object zuweisen, damit du die darin enthaltenen Workbooks / Worksheets auch ansprechen kannst.
Mit deiner Anweisung wird ja nur das entsprechende Fenster aktiviert. Sobald das Fenster den Focus hat, funktioniert ja dein Makro nicht mehr.
Hier mal etwas zum ausprobieren
Option Explicit
'Listet alle aktiven Fenter / Applikation auf
Private Declare Function GetWindow Lib "User32" _
(ByVal appWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" _
(ByVal appWnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" _
(ByVal appWnd As Long) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal appWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As Long, ByVal lpWindowName 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 GetWindowTitle(ByVal appWnd As Long) As String
Dim appResult As Long, appTempStr As String
appResult = GetWindowTextLength(appWnd) + 1
appTempStr = Space(appResult)
appResult = GetWindowText(appWnd, appTempStr, appResult)
GetWindowTitle = Left(appTempStr, Len(appTempStr) - 1)
End Function
Sub CheckWindow()
Dim x As Variant
Dim AppName As String
Dim Qe As Integer
'Mit Parameter 0 wird nur True oder False
'bei der Suche nach dem Programm Namen zurückgegeben
'Mit Parameter 1 erfolgt die Ausgabe aller
'gefundenen Fenster in eine MsgBox
AppName = "Excel"
AppName = InputBox("Bitte geben Sie die Applikation ein, die gesucht werden soll", _
"Suche nach geöffneter Applikation", AppName)
Qe = MsgBox("Soll nur geprüft werden ob die Application: " & AppName & " geöffnet ist?", _
vbQuestion + vbYesNo, "Prüfung")
If Qe = vbYes Then
MsgBox "Applikation: """ & AppName & """ ist geöffnet: " & GetWindowList(AppName, 0)
Else
x = GetWindowList("EXCEL", 1)
End If
End Sub
Public Function GetWindowList(findApp As String, kindMsg As Integer) As Boolean
'Gibt True zurück wenn die Applikation aktiv ist
Dim app() As Long
Dim appWnd As Long, appTitle As String, appStyle As Long, appTask_name() As String
Dim appCount As Integer, appIndex As Integer, appFound As Boolean
Dim msgTxt As String
appWnd = FindWindow(ByVal 0&, ByVal 0&)
appWnd = GetWindow(appWnd, GW_HWNDFIRST)
'1. Initialisierung
GetWindowList = False
Do
'Loop starten durch alle geöffneten Fenster
appFound = False
appStyle = GetWindowLong(appWnd, GWL_STYLE)
appStyle = appStyle And (WS_VISIBLE Or WS_BORDER)
appTitle = GetWindowTitle(appWnd)
'Alle gefundenen Applicationen in einen Array aufnehmen
If (appStyle = (WS_VISIBLE Or WS_BORDER)) = True Then
If Trim(appTitle) <> "" Then
For appIndex = 1 To appCount
If appTask_name(appIndex) = appTitle Then
appFound = True
Exit For
End If
Next appIndex
If Not appFound Then
appCount = appCount + 1
ReDim Preserve appTask_name(1 To appCount)
appTask_name(appCount) = appTitle
ReDim Preserve app(1 To appCount)
app(appCount) = appWnd
End If
End If
End If
appWnd = GetWindow(appWnd, GW_HWNDNEXT)
Loop Until appWnd = 0
'Durchsuchen des erstellten Arrays nach der Application
If kindMsg = 0 Then
For appIndex = 1 To appCount
'Es wird nur der übergebene String in "appTask_Name" gesucht
'Die Instanz selbst wird nicht identifiziert.
'Dazu müsste noch der String "Microsoft" geprüft werden
If InStr(1, appTask_name(appIndex), findApp) > 1 Then
'Application gefunden = Ende der Schleife
GetWindowList = True
Exit Function
End If
Next appIndex
ElseIf kindMsg = 1 Then
For appIndex = 1 To appCount
msgTxt = msgTxt & "Aktiv: " & appTask_name(appIndex) & Chr$(13)
Next appIndex
MsgBox msgTxt
GetWindowList = True
End If
End Function
Function Check_Open_Application(AppName As String) As Boolean
'Test Function
If GetWindowList(AppName) Then
Check_Open_Application = True
Else
Check_Open_Application = False
End If
End Function
Sub Start_Run_Check()
If Check_Open_Application(InputBox _
("Geben Sie den Programmtitel ein." & Chr$(13) & _
"ACHTUNG: Case Sensitiv !!", "Suche Application", "Excel")) = True Then
Debug.Print "Test erfolgreich"
Else
Debug.Print "Test nicht erfolgreich"
End If
End Sub
Sub Open_Test_File()
Dim s$, AppExec As Long
s = "c:\test.txt"
If GetWindowList("Editor") Then
'AppExec = ShellExecute(2140, vbNullString, s, "", "", 1)
Debug.Print "OK"
Else
MsgBox "Applikation nicht aktiv"
End If
End Sub
Hast du eine Instanz gefunden, musst du natürlich prüfen, OB in dieser Instanz auch DEINE von dir GESUCHTE Mappe ist,... denn das ist ja nicht gesichtert
Gruss Rainer