Mit Hilfe eines Fenstertitels Objekt setzen ?

Servus,
aus meinem Kassensystem wird eine xls-Report erstellt, den ich weiterverarbeiten muss. Das Problem an der Sache ist, das dieser Report immer in einer neuen xls-Applications-Instanz geöffnet wird.
Ich habe mir mit zusammengesuchten API Funktionen nun schon das passende Fenster gesucht (siehe Code), wie kann ich nun die richtige Application als Objekt ansprechen um die Daten aus meiner ersten Applications-Instanz heraus zu steuern.
Genauer ich will nur das Blatt EXPORT in meine Anwendung kopieren ?
Irgendjemand eine Idee, danke vorab ?

Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
    ByVal wCmd As Long) As Long
Private Declare Function GetClassName& Lib "user32" Alias _
    "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName _
    As String, ByVal nMaxCount As Long)
Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" ( _
    ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Public Function GetActiveWindowTitle(nHWnd As Long) As String
    Dim sTitle As String
    Dim nResult As Long
    sTitle = Space$(255)
    nResult = GetWindowText(nHWnd, sTitle, Len(sTitle))
    GetActiveWindowTitle = Left$(sTitle, nResult)
End Function
Function ExcelApp(Name As String) As Object
Dim Länge&, hwnd&
Dim Klassenname As String
Dim strName As String
hwnd = GetWindow(GetDesktopWindow, GW_CHILD)
Do
    Klassenname = String(51, 0)
    Länge = GetClassName&(hwnd, Klassenname, 50)
    If Left(Klassenname, Länge) = "XLMAIN" Then
        strName = GetActiveWindowTitle(hwnd)
        If Right(strName, Len(strName) - 18) = Name Then
            Set ExcelApp = GetObject(strName) 'das funktioniert nicht
            Exit Do
        End If
    End If
    hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop While hwnd <> 0
End Function

MfG Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
schau dir das mal an:


Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd 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 GetNextWindow Lib "user32" Alias "GetWindow" (ByVal _
hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal _
hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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
Private Declare Function GetObjectAPI Lib "gdi32" _
Alias "GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, lpObject As Any) As Long
Declare Function BringWindowToTop Lib "user32" ( _
ByVal hwnd As Long) As Long
Public Declare Function SetActiveWindow Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Const GW_HWNDNEXT = 2
Public hWndArray() As Long
Public xlNames() As String
Private Function GetWindowTitle(ByVal hwnd As Long) As String
Dim lResult As Long, sTemp As String
lResult = GetWindowTextLength(hwnd) + 1
sTemp = Space(lResult)
lResult = GetWindowText(hwnd, sTemp, lResult)
GetWindowTitle = Left(sTemp, Len(sTemp) - 1)
End Function
'Liest andere Excel-Instanzen ins Array hWndArray(), Anzahl in hWndArray(0)
Sub GetXLInstances()
Dim hwnd As Long, lRet As Long
Dim i As Integer, j As Integer
Dim sClassBuffer As String
On Error GoTo errhandler
i = 0
ReDim hWndArray(i)
hWndArray(0) = i
hwnd = FindWindow("XLMAIN", vbNullString)
If hwnd <> 0 Then
If hwnd <> Application.hwnd Then
i = i + 1
ReDim Preserve hWndArray(i)
hWndArray(i) = hwnd
hWndArray(0) = i
End If
Do
hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
If hwnd = 0 Then Error 7
sClassBuffer = String(255, 0)
lRet = GetClassName(hwnd, sClassBuffer, Len(sClassBuffer))
sClassBuffer = Left(sClassBuffer, InStr(1, sClassBuffer, Chr(0), _
vbTextCompare) - 1)
If UCase(sClassBuffer) = "XLMAIN" And hwnd <> Application.hwnd Then
i = i + 1
ReDim Preserve hWndArray(i)
hWndArray(i) = hwnd
hWndArray(0) = i
End If
Loop
End If
errhandler:
End Sub
Sub HoleInstanzen()
Dim i As Integer
Dim xl As Object
Dim sTitle As String
Dim m As Integer, m0 As Integer
GetXLInstances
For i = 1 To hWndArray(0)
sTitle = GetWindowTitle(hWndArray(i))
Debug.Print hWndArray(i), GetWindowTitle(hWndArray(i))
Debug.Print Trim(Split(sTitle, "-")(1))
Debug.Print Trim(Split(sTitle, "-")(0))
On Error Resume Next
Set xl = GetObject(Trim$(Split(sTitle, "-")(1)))
If xl Is Nothing Then Set xl = GetObject(Trim(Split(sTitle, "-")(0)))
If xl Is Nothing Then Set xl = GetObject(Trim(sTitle))
If xl Is Nothing Then
Debug.Print "[keine Zuordnung möglich]"
Else
m = xl.Application.Workbooks.Count
Debug.Print "Instanz " & hWndArray(i) & " hat " & m & " offene Mappen:"
For m0 = 1 To m
Debug.Print "     " & xl.Application.Workbooks(m0).Name
Next m0
End If
Set xl = Nothing
Next i
End Sub

Die Prozedur, die du anpassen musst, ist HoleInstanzen(). Hier werden alle fremden Instanzen aufgelistet mit einigen Eingenschaften des Excel-Objektes.
Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Mit Hilfe eines Fenstertitels Objekt setzen ?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread