Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1712to1716
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Excel-Datei nicht im Projekt-Explorer

Excel-Datei nicht im Projekt-Explorer
26.09.2019 15:40:55
Andreas
Hallo zusammen,
ich bin VBA-Neuling und versuche mich gerade an einer Programmierung. Ich versuche per VBA einen Prozess im SAP abzuarbeiten.
Bei der Abarbeitung des Projektcodes werden durch das SAP 2 Excel-Dateien gespeichert und relativ kurzfristig geöffnet (ca. 3-5 Sek. nach dem Speichern).
Ich hätte erwartet, dass die Dateien dann im Projekt-Explorer zu sehen sind, die ich dann ansprechen kann. Selbst nachdem der Code vollständig durchlaufen ist, sind die Dateien, obwohl geöffnet, nicht im Projekt-Explorer zu sehen.
Schließe ich die Datei und öffne diese, ist diese im Projekt-Explorer zu sehen. Welche Möglichkeiten habe ich nun, einerseits die Dateien zu schließen, aber auch andererseits eine Datei anzusprechen, damit der Inhalt in eine andere Auswertung kopiert werden kann?
Ich bedanke mich im Voraus und wünsche einen schönen Tag :)
Gruß
Andi

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Was ist der Projekt-Explorer ? (owT)
26.09.2019 15:46:35
EtoPHG

AW: Was ist der Projekt-Explorer ? (owT)
26.09.2019 15:52:20
Andreas
hier, das meine ich, heißt das nicht so?
Userbild
Ich habe das Problem, dass, weil die Datei da nicht aufgeführt wird, aber bereits offen ist, kann ich diese ja nicht aktivieren oder ansprechen... oder?
Doch das heisst schon so,
26.09.2019 17:42:56
EtoPHG
Andreas,
Aber ich hab das nicht erwartet. Ich kenne deine SAP-Code nicht, nimmt aber an, dass dieser in einer anderen Excelinstanz abgearbeitet wird, wie die Instanz, in der deine Arbeitsmappe geöffnet ist. Oder ich müsste deinen 'SAP-Code' mal sehen. Du siehst im Projekt-Explorer nur Arbeitsmappen (neben ev. Add-Ins), die du entweder manuell oder über VBA Code programmatisch geöffnet hast.
Allerdings ist mir dein Anliegen noch unklar. Vielleicht kannst du genauere Details zu deinen Vorstellungen/Anforderungen liefern?
Gruess Hansueli
Anzeige
AW: Doch das heisst schon so,
26.09.2019 19:07:36
Andreas
Es soll aus SAP eine Datei als Tabellenkalkulation gespeichert werden. Nachdem SAP eine Datei speichert, wird diese mit einem Versatz von wenigen Sekunden auch automatisch geöffnet. Ich möchte nun, dass erst abgewartet wird, bis die Datei geöffnet ist, damit diese wieder geschlossen werden kann (bei einer anderen Datei werde ich warten müssen, bis die Datei geöffnet wurde, anschließend soll der Inhalt einer Spalte kopiert und woanders eingefügt werden, anschließend Datei wieder schließen). Ich komme nicht mehr weiter - so nervig!
Ich befürchte, weil die 2 Dateien aus SAP gespeichert und geöffnet werden, erkennt der Projekt Explorer beide Dateien nicht. Ich kann diese dann auch nicht ansprechen?!
Hier der Code, inkl. Zeilen vom SAP-Recorder sowie auch einige Versuche von mir, die aber _ irgendwie nicht klappten... :( objSess.findById("wnd[1]/usr/ctxtDY_PATH").Text = "J:\Test\Test" objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Input_Query_Masse1.xlsx" objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 18 objSess.findById("wnd[1]/tbar[0]/btn[11]").press geladen = False Do For Each wb In Workbooks If wb.Name = "Input_Query_Masse1.xlsx" Then geladen = True Next wb Loop Until geladen = True End

Function 

Sub DateiSchließen_ohne_speichern() ' Datei schließen Workbooks("Input_Query_Masse1.xlsx"). _
Close SaveChanges:=False End 

Sub 

Function ProcessRow1(iRow) Dim lineitems As Long Dim W_Tagesdatum Dim W_QuellID ' Workbooks(„ _
Input_Query_Masse1.xlsx“).Close ' Set objWorkbook1 = Workbooks(Input_Query_Masse1.XLSX) ' Call objWorkbook1.Close ' Set objWorkbook1 = Workbooks(Input_Query_Masse1.XLSX) 'Open("J:\Kundenservice\Verbrauchsabrechnung\Abrechnung\MOS Billing\Durchführung MOSB\Input_Query_Masse1.XLSX") ' Call objWorkbook1.RefreshAll ' Call objWorkbook1.Close(SaveChanges:=True) ' Set objWorkbook1 = Nothing

Anzeige
Nachrichten/Anfragen/Vorschau Struktur....
27.09.2019 08:12:30
EtoPHG
Hallo Andreas,
Zu deinem neuem Beitrag:
Ich kann deinem Kauderwelsch nicht folgen.
Versuche doch dein Informationen besser zu strukturieren. Die Forumssoftware stellt dafür, wenn auch einfache, so doch genügend, Mittel zur Verfügung. Zudem gibt es den [Vorschau] Button, mit dem die Lesbarkeit und Struktur nochmals überprüft werden kann, bevor der Beitrag definitiv im Forum landet. Ich frage mich öfter, warum das nicht benutzt wird.
Zum Problem:
  • Nepumuk hat Dir unten einen Code zum Ausfindigmachen der XL-Instanz gepostet.

  • Ein weiterer Ansatz: Wenn Dir die abgelegten Dateinamen, bzw. Verzeichnisse zur bekannt sind, kann ggf. Code aufgebaut werden, der mit diesen Informationen letztere weiterverarbeitet.

  • Gruess Hansueli
    Anzeige
    AW: Nachrichten/Anfragen/Vorschau Struktur....
    27.09.2019 08:54:54
    Andreas
    Guten Morgen,
    ja, tut mir leid. Das ist absolut unübersichtlich! Sorry! Ich hatte das gestern Abend am Handy gemacht, ging ja voll daneben :(
    Obwohl der u.s. Code für einen VBA Erfahrenen wohl ein komplett chaotischen Aufbau hat, scheint er fast zu funktionieren. Das einzige Problem, das ich habe, ist "lediglich", dass die zwei Dateien, die über SAP erstellt werden (Input_Query_Masse1.xlsx und Kontrolle1.xlsx) nicht im Projekt-Explorer erkannt werden und daher auch nicht geschlossen werden... muss ich diese irgendwie vorher "aktivieren"?!
    Also den Code von Nepumuk hatte ich irgendwie total übersehen! Sorry... Bedeutet das, ich baue diesen ein und mein letzter Befehl, alle Dateien bis auf die mit dem Makro zu schließen, wird für alle Excel-Dateien durchgeführt? Das scheint ein richtig dicker Befehl zu sein ;)
    Also hier der gesamte Code:
    Option Explicit
    Public SapGuiAuto, WScript, msgcol
    Public objGui As GuiApplication
    Public objConn As GuiConnection
    Public objSess As GuiSession
    Public objSBar As GuiStatusbar
    Public objSheet As Worksheet
    Public objSheet1 As Worksheet
    Public objSheet2 As Worksheet
    Public wb As Workbook
    Public geladen As Boolean
    Dim W_System
    Dim iCtr As Integer
    Dim objWorkbook As Workbook
    Dim objWorkbook1 As Workbook
    Dim objWorkbook2 As Workbook
    Dim objWorkbook3 As Workbook
    ' Dim liWs As Integer
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Function Attach_Session(iRow, Optional mysystem As String) As Boolean
    Dim il, it
    Dim W_conn, W_Sess
    ' Entsprechendes System prüfen
    ' Zelle A4 (XXX System, YYY Mandant)
    If mysystem = "" Then
    W_System = ActiveSheet.Cells(iRow, 1)
    Else
    W_System = mysystem
    End If
    ' Wenn bereits Module vorhanden, beende aktuelle Funktion
    If W_System = "" Then
    Attach_Session = False
    Exit Function
    End If
    ' Wenn die Session Objekt ist nicht leer, nehme die aktive Session (gehe von der richtigen Session aus)
    If Not objSess Is Nothing Then
    If objSess.Info.SystemName & objSess.Info.Client = W_System Then
    Attach_Session = True
    Exit Function
    End If
    End If
    ' Wenn keine Verbinbdung, setze Objekte
    If objGui Is Nothing Then
    Set SapGuiAuto = GetObject("SAPGUI")
    Set objGui = SapGuiAuto.GetScriptingEngine
    End If
    ' Schaue alle SAP Module durch und prüfe, welches System ist das gleiche mit der korrekten Transaktion
    For il = 0 To objGui.Children.Count - 1
    Set W_conn = objGui.Children(il + 0)
    For it = 0 To W_conn.Children.Count - 1
    Set W_Sess = W_conn.Children(it + 0)
    If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
    Set objConn = objGui.Children(il + 0)
    Set objSess = objConn.Children(it + 0)
    Exit For
    End If
    Next
    Next
    ' Wurde nichts gefunden, kommt die Fehlermeldung
    If objSess Is Nothing Then
    MsgBox "richtiges System? " + W_System + " mit Transaktion ", vbCritical + vbOKOnly
    Attach_Session = False
    Exit Function
    End If
    ' Schalte Script ein
    If IsObject(WScript) Then
    WScript.ConnectObject objSess, "on"
    WScript.ConnectObject objGui, "on"
    End If
    ' Maximiere die Session
    Set objSBar = objSess.findById("wnd[0]/sbar")
    objSess.findById("wnd[0]").Maximize
    Attach_Session = True
    End Function
    Public Sub StartProcessing()
    Dim W_Obj1, W_Obj2, W_Obj3, W_Obj4, iRow
    Dim W_Func
    Dim W_Src_Ord
    Dim W_Ret As Boolean
    ' Mit System verbunden? Zelle A4
    W_Ret = Attach_Session(4)
    If Not W_Ret Then
    MsgBox "Nicht mit System verbunden"
    GoTo MyEnd
    End If
    ' Rufe Funktion ProcessRow auf
    Call Massenanforderung
    Call Query1
    Call Massenabrechnung
    Call Sleep1
    Call AlleSchliessen
    MyEnd:
    ' Setze alles zurück, Speicher freisetzen
    Set objSess = Nothing
    Set objGui = Nothing
    Set SapGuiAuto = Nothing
    MsgBox "Script erledigt", vbInformation + vbOKOnly
    End Sub
    
    Function Massenanforderung()
    Set objSheet = ThisWorkbook.Worksheets("Script")
    ' Setzt den Status-Text auf "führt aus..."
    objSheet.Cells(9, 4) = "führt aus..."
    ' SAP Script hier
    objSess.findById("wnd[0]").Maximize
    objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nFKKBIXBIP_M"
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/usr/cmbPROBCL").Key = "4"
    objSess.findById("wnd[0]/usr/cmbPROBCL").SetFocus
    objSess.findById("wnd[0]/tbar[1]/btn[8]").press
    objSess.findById("wnd[1]/tbar[0]/btn[0]").press
    ' SAP Meldung wird ausgegeben in Spalte 5 (iRow, 5)
    objSheet.Cells(9, 5) = objSBar.Text
    ' Setzt den Status auf erledigt
    objSheet.Cells(9, 4) = "erledigt"
    End Function Function Query1()
    Dim W_Tagesdatum
    Dim W_QuellID
    Set objSheet1 = ThisWorkbook.Worksheets("Hilfstabelle")
    ' Setzt den Status-Text auf "führt aus..."
    objSheet.Cells(11, 4) = "führt aus..."
    ' Abrechnungssperrgrund
    W_Tagesdatum = objSheet.Cells(1, 5)
    ' SAP Script hier
    objSess.findById("wnd[0]").Maximize
    objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nsa38"
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/usr/ctxtRS38M-PROGRAMM").Text = "AQP0SYSTQV000025MOSB_MASSE1==="
    objSess.findById("wnd[0]/usr/ctxtRS38M-PROGRAMM").caretPosition = 31
    objSess.findById("wnd[0]/tbar[1]/btn[18]").press
    objSess.findById("wnd[1]").sendVKey 4
    objSess.findById("wnd[2]/usr/cntlALV_CONTAINER_1/shellcont/shell").SelectedRows = "0"
    objSess.findById("wnd[2]/usr/cntlALV_CONTAINER_1/shellcont/shell").DoubleClickCurrentCell
    objSess.findById("wnd[1]/tbar[0]/btn[0]").press
    objSess.findById("wnd[0]/tbar[1]/btn[8]").press
    objSess.findById("wnd[0]/usr/cntlCONTAINER/shellcont/shell").PressToolbarContextButton "&MB_EXPORT"
    objSess.findById("wnd[0]/usr/cntlCONTAINER/shellcont/shell").SelectContextMenuItem "&XXL"
    objSess.findById("wnd[1]/usr/ctxtDY_PATH").Text = "J:\Durchführung"
    objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Input_Query_Masse1.xlsx"
    objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 18
    objSess.findById("wnd[1]/tbar[0]/btn[11]").press
    ' SAP Meldung wird ausgegeben in Spalte 5 (iRow, 5)
    objSheet.Cells(11, 5) = objSBar.Text
    ' Setzt den Status auf erledigt
    objSheet.Cells(11, 4) = "erledigt"
    ' Zuerst Hilfstabelle Inhalt löschen
    objSheet1.Range("A1:D999999").ClearContents
    ' Datei "Output" öffnen und aktualisieren
    Set objWorkbook = Workbooks.Open("J:\Durchführung\Output.xlsx")
    Call objWorkbook.RefreshAll
    Set objWorkbook = Nothing
    ' Kopieren Quellvorgangs-ID aus Output
    Sheets("Gesamt ohne Fehler").Range("C2:C999999").Copy
    ' Einfügen in Zieldatei
    objSheet1.Range("A1:A999999").PasteSpecial
    ' Quellvorgangs-ID
    W_QuellID = objSheet1.Range("A1:A999999")
    End Function
    Function Massenabrechnung()
    Dim W_Tagesdatum
    Dim W_QuellID
    Set objSheet = ThisWorkbook.Worksheets("Script")
    Set objSheet1 = ThisWorkbook.Worksheets("Hilfstabelle")
    ' Setzt den Status-Text auf "führt aus..."
    objSheet.Cells(12, 4) = "führt aus..."
    ' Abrechnungssperrgrund
    W_Tagesdatum = objSheet.Cells(1, 5)
    ' SAP Script hier
    objSess.findById("wnd[0]").Maximize
    objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nFKKBIX_M"
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/tbar[1]/btn[17]").press
    objSess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").SelectedRows = "0"
    objSess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").DoubleClickCurrentCell
    objSess.findById("wnd[0]/usr/ctxtP_BILLDT").Text = W_Tagesdatum
    objSess.findById("wnd[0]/usr/ctxtP_BILLDT").SetFocus
    objSess.findById("wnd[0]/usr/ctxtP_BILLDT").caretPosition = 10
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/tbar[1]/btn[6]").press
    objSess.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/btn%_%%DYN001_%_APP_%-VALU_PUSH").press
    objSess.findById("wnd[2]/tbar[0]/btn[16]").press
    objSess.findById("wnd[2]/tbar[0]/btn[24]").press
    objSess.findById("wnd[2]/tbar[0]/btn[8]").press
    objSess.findById("wnd[1]/tbar[0]/btn[11]").press
    objSess.findById("wnd[0]/tbar[1]/btn[8]").press
    objSess.findById("wnd[1]/tbar[0]/btn[0]").press
    ' SAP Meldung wird ausgegeben in Spalte 5 (iRow, 5)
    objSheet.Cells(12, 5) = objSBar.Text
    ' Setzt den Status auf erledigt
    objSheet.Cells(12, 4) = "erledigt"
    ' Setzt den Status-Text auf "führt aus..."
    objSheet.Cells(13, 4) = "führt aus..."
    ' SAP Script hier
    objSess.findById("wnd[0]").Maximize
    objSess.findById("wnd[0]/tbar[0]/okcd").Text = "/nFKKBIXBIT_MON"
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/tbar[1]/btn[17]").press
    objSess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").SelectedRows = "0"
    objSess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").DoubleClickCurrentCell
    objSess.findById("wnd[0]/usr/ctxtBITCRDAT-HIGH").Text = W_Tagesdatum
    objSess.findById("wnd[0]/usr/ctxtBITCRDAT-HIGH").SetFocus
    objSess.findById("wnd[0]/usr/ctxtBITCRDAT-HIGH").caretPosition = 10
    objSess.findById("wnd[0]").sendVKey 0
    objSess.findById("wnd[0]/tbar[1]/btn[8]").press
    objSess.findById("wnd[0]/usr/cntlMON_CONTROL/shellcont/shell").PressToolbarButton "&MB_VARIANT"
    objSess.findById("wnd[1]/usr/cntlGRID/shellcont/shell").CurrentCellRow = 0
    objSess.findById("wnd[1]/usr/cntlGRID/shellcont/shell").SelectedRows = "0"
    objSess.findById("wnd[1]/usr/cntlGRID/shellcont/shell").ClickCurrentCell
    objSess.findById("wnd[0]/usr/cntlMON_CONTROL/shellcont/shell").PressToolbarContextButton "&MB_EXPORT"
    objSess.findById("wnd[0]/usr/cntlMON_CONTROL/shellcont/shell").SelectContextMenuItem "&XXL"
    objSess.findById("wnd[1]/usr/ctxtDY_PATH").Text = "J:\Durchführung"
    objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Kontrolle1.xlsx"
    objSess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 14
    objSess.findById("wnd[1]/tbar[0]/btn[11]").press
    ' SAP Meldung wird ausgegeben in Spalte 5 (iRow, 5)
    objSheet.Cells(13, 5) = objSBar.Text
    ' Setzt den Status auf erledigt
    objSheet.Cells(13, 4) = "erledigt"
    ' Datei "Kontrolle" öffnen und löschen
    Set objWorkbook2 = Workbooks.Open("J:\Durchführung\Kontrolle.xlsx")
    Set objSheet2 = objWorkbook2.Worksheets("Tabelle1")
    ' Set objWorkbook2 = Nothing
    objSheet2.Range("A2:C999999").ClearContents
    ' Kopieren Abrechnungsbelege
    ' Sheets("Gesamt ohne Fehler").Range("C2:C999999").Copy
    ' Workbooks(„Kontrolle1.xlsx“).Range(A2:A999999")
    ' Einfügen in Zieldatei
    ' objSheet1.Range("A1:A999999").PasteSpecial
    ' Quellvorgangs-ID
    ' W_QuellID = objSheet1.Range("A1:A999999")
    End Function Function Sleep1()
    Call Sleep(10000)
    End Function
    Function AlleSchliessen()
    Dim Wkb As Workbook
    For Each Wkb In Workbooks
    If Wkb.Name ThisWorkbook.Name And Wkb.Name "MOSB Automatismus.xlsm" Then
    Wkb.Close SaveChanges:=True
    End If
    Next Wkb
    End Function
    Anzeige
    AW: Was ist der Projekt-Explorer ? (owT)
    26.09.2019 17:49:08
    Nepumuk
    Hallo Andreas,
    SAP öffnet die Datei in einer eigenen Application. Schau mal in den Taskmanager da findest du zwei Excel-Prozesse. Der Zugriff auf diese Application ist möglich, aber nicht ohne.
    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 Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type

    Private Const GC_CLASSNAMEEXCEL = "XLMAIN"
    Private Const GC_CLASSNAMEEXCEL7 = "EXCEL7"
    Private Const IID_EXCELWINDOW = "{00020893-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 Application()
        
        Dim ialngIndex As Long, ialngCount As Long
        Dim udtGuid As GUID
        Dim objWindow As Window
        Dim aobjTempApplications() As Application
        
        'Alle lokalen Variablen zuruecksetzen
        Erase lalngChildHwnd
        lialngChildCount = 0
        Erase lalngMainHwnd
        lialngMainCount = 0
        
        'Konvertiere die IID des Excel-Window-Objektes in die GUID-Struktur
        Call IIDFromString(StrConv(IID_EXCELWINDOW, vbUnicode), udtGuid)
        
        'Callback Aufruf um alle Fenster zu klassifizieren
        Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
        
        'Schleife ueber alle gefundenen Parent-Excelfenster
        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 Function

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

        
        'Callback Funktion um alle Fenster zu durchlaufen
        
        'Wenn ein Excelfenster gefunden wurde schreibe dessen Handle in das Array
        If ClassName(pvlngHwnd) = GC_CLASSNAMEEXCEL 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 Excel-Fenster gefunden wurde schreibe
        'dessen Handle in das Array und verlasse die Callback-Prozedur
        If ClassName(pvlngHwnd) = GC_CLASSNAMEEXCEL7 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 Test()
        
        'Testprozedur die in allen Instanzen alle Tabellen in allen Mappen durchsucht
        
        Dim aobjApplications() As Application
        Dim ialngIndex As Long
        Dim objWorkbook As Workbook, objWorksheet As Worksheet
        Dim objDictionary As Object
        Dim avntApplications As Variant, vntApplicationItem As Variant
        Dim strFirstAddress As String
        
        'Hole die Application-Objekte alle geoeffneten Excelinstanzen
        aobjApplications = GetApplications
        
        'Neue Instanzt eines Dictionary-Objektes erstellen
        Set objDictionary = CreateObject("Scripting.Dictionary")
        
        'Schleife ueber alle Application-Objekte
        For ialngIndex = LBound(aobjApplications) To UBound(aobjApplications)
            
            'Mehrfach gefundene Instanzen herausfiltern
            If Not objDictionary.Exists(aobjApplications(ialngIndex).hwnd) Then _
                Call objDictionary.Add(aobjApplications(ialngIndex).hwnd, aobjApplications(ialngIndex))
            
            'Objet zuruecksetzen
            Set aobjApplications(ialngIndex) = Nothing
            
        Next
        
        'Instanzen aus dem Dictionary holen
        avntApplications = objDictionary.Items
        
        'Objet zuruecksetzen
        Set objDictionary = Nothing
        
        'Schleife ueber alle Application-Objekte
        For Each vntApplicationItem In avntApplications
            
            For Each objWorkbook In vntApplicationItem.Workbooks
                
                MsgBox objWorkbook.Name
                
                For Each objWorksheet In objWorkbook.Worksheets
                    
                    MsgBox objWorksheet.Name
                    
                Next
            Next
        Next
        
        'Array zuruecksetzen
        Erase avntApplications
    End Sub

    Gruß
    Nepumuk
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige