Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Zugriff auf alle offenen Word-Instanzen
zurück: Gefilterte Liste in Listbox / Combobox anzeigen weiter: Spezielle Klassen - Teil 5 - Application Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Information Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Isabelle :-)
Menschin


Verfasst am:
08. Apr 2013, 14:16
Rufname:
Wohnort: Westlicher Spiralarm der Galaxis


Zugriff auf alle offenen Word-Instanzen - Zugriff auf alle offenen Word-Instanzen

Nach oben
       Version: Office 2k (2000)

Hallöchen,

der Mechanismus ist praktisch identisch mit dem Tipp: Zugriff auf alle offenen Excel-Instanzen

Nur in der Nachbehandlung der gefundenen Instanzen müssen die darin enthaltenen Dokumente nach doppelten gefiltert werden, da jedes Word-Dokument ein eigenes Handle der Word-Klasse zurückliefert.

Code:
Option Explicit

Private Declare Function GetClassNameA Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Boolean
Private Declare Function EnumChildWindows Lib "user32.dll" ( _
    ByVal hWndParent As Long, _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long
Private Declare Sub IIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As String, _
    ByRef lpiid As GUID)
Private Declare Sub AccessibleObjectFromWindow Lib "oleacc.dll" ( _
    ByVal hwnd As Long, _
    ByVal dwId As Long, _
    ByRef riid As GUID, _
    ByRef ppvObject As Any)
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
    ByRef psa() As Any) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Const GC_CLASSNAMEWORD = "OpusApp"
Private Const GC_CLASSNAMEWORDWINDOW = "_WwG"
Private Const IID_WORDWINDOW = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM = &HFFFFFFF0

Private lalngChildHwnd() As Long, lialngChildCount As Long
Private lalngMainHwnd() As Long, lialngMainCount As Long

Private Function GetApplications() As Object()

    Dim ialngIndex As Long, ialngCount As Long
    Dim udtGuid As GUID
    Dim objWindow As Object
    Dim aobjTempApplications() As Object

    'Alle lokalen Variablen zuruecksetzen
    Erase lalngChildHwnd
    lialngChildCount = 0
    Erase lalngMainHwnd
    lialngMainCount = 0

    'Konvertiere die IID des Word-Window-Objektes in die GUID-Struktur
    Call IIDFromString(StrConv(IID_WORDWINDOW, vbUnicode), udtGuid)

    'Callback Aufruf um alle Fenster zu klassifizieren
    Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)

    'Wenn offene Word-Fenster gefunden wurden
    If lialngMainCount > 0 Then

        'Schleife ueber alle gefundenen Parent-Wordfenster
        For ialngIndex = LBound(lalngMainHwnd) To UBound(lalngMainHwnd)

            'Callback Aufruf um alle Child-Fenster der
            'entsprechenden Parent-Fenster zu durchlaufen
            Call EnumChildWindows(lalngMainHwnd(ialngIndex), _
                AddressOf EnumChildWindowsProc, ByVal 0&)

        Next

        'Schleife ueber die jeweils ersten gefundenen Window-Fenster
        For ialngIndex = LBound(lalngChildHwnd) To UBound(lalngChildHwnd)

            'Hole ueber die Zugriffsnummer das entsprechende Window-Objekt
            Call AccessibleObjectFromWindow(lalngChildHwnd(ialngIndex), _
                OBJID_NATIVEOM, udtGuid, objWindow)

            'Wenn das Objekt gefunden wurde setze einen Verweis
            'auf dessen Application-Objekt in das Array
            If Not objWindow Is Nothing Then

                ReDim Preserve aobjTempApplications(ialngCount)
                Set aobjTempApplications(ialngCount) = objWindow.Application
                ialngCount = ialngCount + 1

            End If
        Next

        'Array an die Funktionsvariable uebergeben
        GetApplications = aobjTempApplications

    End If
End Function

Private Function EnumWindowsProc( _
    ByVal pvlngHwnd As Long, _
    ByVal pvlnglParam As Long) As Long

    'Callback Funktion um alle Fenster zu durchlaufen

    'Wenn ein Wordfenster gefunden wurde schreibe dessen Handle in das Array
    If ClassName(pvlngHwnd) = GC_CLASSNAMEWORD Then

        ReDim Preserve lalngMainHwnd(lialngMainCount)
        lalngMainHwnd(lialngMainCount) = pvlngHwnd
        lialngMainCount = lialngMainCount + 1

    End If

    EnumWindowsProc = 1

End Function

Private Function EnumChildWindowsProc( _
    ByVal pvlngHwnd As Long, _
    ByVal pvlnglParam As Long) As Long

    'Callback Funktion um alle Child-Fenster zu durchlaufen

    'Wenn ein Window-Fenster im Word-Fenster gefunden wurde schreibe
    'dessen Handle in das Array und verlasse die Callback-Prozedur
    If ClassName(pvlngHwnd) = GC_CLASSNAMEWORDWINDOW Then

        ReDim Preserve lalngChildHwnd(lialngChildCount)
        lalngChildHwnd(lialngChildCount) = pvlngHwnd
        lialngChildCount = lialngChildCount + 1

        EnumChildWindowsProc = 0

    Else

        EnumChildWindowsProc = 1

    End If
End Function

Private Function ClassName( _
    ByVal pvlngHwnd As Long) As String

    'Funktion zum Ermitteln des Klassennames

    Dim strClassName As String * 256
    Dim lngReturn As Long

    'Lese den Klassenname des Handles
    lngReturn = GetClassNameA(pvlngHwnd, strClassName, Len(strClassName))

    'Klassenname an die Funktionsvariable uebergeben
    ClassName = Left$(strClassName, lngReturn)

End Function

Public Sub Liste_aller_Dokumente()

    'Testprozedur

    Dim aobjApplications() As Object
    Dim objDocument As Object
    Dim objDictionary As Object
    Dim avntDocuments As Variant
    Dim ialngIndex As Long

    'Hole die Application-Objekte alle geoeffneten Wordinstanzen
    aobjApplications = GetApplications

    'Wenn offene Word-Fenster mit Dokumenten gefunden wurden
    If CBool(SafeArrayGetDim(aobjApplications)) Then

        'Neue Instanzt eines Dictionary-Objektes erstellen
        Set objDictionary = CreateObject("Scripting.Dictionary")

        'Schleife ueber alle Application-Objekte
        For ialngIndex = LBound(aobjApplications) To UBound(aobjApplications)

            'Schleife ueber alle Dokumnete in der Application
            For Each objDocument In aobjApplications(ialngIndex).Documents

                'Mehrfach gefundene Dokumente herausfiltern
                If Not objDictionary.Exists(objDocument.FullName) Then _
                    Call objDictionary.Add(objDocument.FullName, objDocument)

            Next

            Set aobjApplications(ialngIndex) = Nothing

        Next

        'Dokumnete aus dem Dictionary holen
        avntDocuments = objDictionary.Items

        'Scheife ueber alle Dokumente
        For ialngIndex = LBound(avntDocuments) To UBound(avntDocuments)

            'Z.B. den Namen ausgeben
            Debug.Print avntDocuments(ialngIndex).Name

        Next

        Set objDictionary = Nothing
        Erase avntDocuments

    Else
        Call MsgBox("Keine Word-Dokument geöffnet.", vbExclamation, "Hinweis")
    End If
End Sub

Das Programm habe ich unter Windows 2000, XP, Vista und 7 mit Excel 2000, 2002, 2003, 2007, 2010 und 2013 (alle 32Bit) und den zugehörigen Word-Versionen getestet.

_________________
LG Isi

Die Mitgliedschaft im Forum erhöht deine Chance auf eine Antwort von mir um 99,999%
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: suche eine Formel zum Darstellen von offenen Tagen 22 MrTux 390 09. Okt 2013, 08:50
MrTux suche eine Formel zum Darstellen von offenen Tagen
Keine neuen Beiträge Excel Formeln: Zugriff auf Summenwerte mehrere einzelnen Excelmappen 4 Heval 97 10. Sep 2013, 10:01
Heval Zugriff auf Summenwerte mehrere einzelnen Excelmappen
Keine neuen Beiträge Excel Formeln: SVERWEIS mit Zugriff auf mehrere Spalten der Zielzeile 5 sverWEIS_ICH_NICHT 94 08. Mai 2013, 16:51
Jensolator SVERWEIS mit Zugriff auf mehrere Spalten der Zielzeile
Keine neuen Beiträge Excel Formeln: Zugriff auf Zellen in anderer Datei absolut ohne indirekt 9 HansW 291 03. Mai 2013, 12:50
theoS Zugriff auf Zellen in anderer Datei absolut ohne indirekt
Keine neuen Beiträge Excel Formeln: Autoausfüllen mit Zugriff auf benannten Tabellenbereich 1 Hügel 599 25. Jan 2012, 14:31
Gast Autoausfüllen mit Zugriff auf benannten Tabellenbereich
Keine neuen Beiträge Excel Formeln: Zugriff auf Matrix über Index per Formel 14 ghandi 388 24. Aug 2011, 21:36
Gast Zugriff auf Matrix über Index per Formel
Keine neuen Beiträge Excel Formeln: Zugriff auf Variable Tabelle 4 OneFox 594 28. Jun 2011, 18:55
OneFox Zugriff auf Variable Tabelle
Keine neuen Beiträge Excel Formeln: Frage zum Zugriff auf Tabellenblätter 3 Christian2112xxx 201 22. Sep 2010, 07:49
Christian-threadersteller Frage zum Zugriff auf Tabellenblätter
Keine neuen Beiträge Excel Formeln: Variabler zugriff auf Datensatz anderer Tabelle 1 willy05 385 23. Jul 2010, 09:41
shift-del Variabler zugriff auf Datensatz anderer Tabelle
Keine neuen Beiträge Excel Formeln: Excel Zugriff nur auf bestimmte Felder 2 gim330 1299 08. Apr 2007, 20:53
gim330 Excel Zugriff nur auf bestimmte Felder
Keine neuen Beiträge Excel VBA (Makros): Zugriff auf ganzen Ordner 3 Martin86 498 01. Aug 2006, 16:33
Gast Zugriff auf ganzen Ordner
Keine neuen Beiträge Excel VBA (Makros): Zugriff auf Zellen aus Funktionen der Modulebene heraus 6 Eriks 791 19. Mai 2006, 21:03
Gast Zugriff auf Zellen aus Funktionen der Modulebene heraus
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Access Tabellen