none
Auflistung aller Objekte

    Frage

  • Hallo zusammen

    Für eine Suchfunktion möchte ich alle Objekte auflisten (per Klasse). Dazu gehören auch die Kontrollfelder eines Formulares. Während in einer Tabelle mit Tabledefs die Tabelle nicht geöffnet werden muss, ist das, soweit ich weiss, bei Formularen (und Berichten) nötig.
    Jetzt möchte ich aber die Auflistung aus einem Formular ausführen, welches auch UFO's enthält. Dazu ist es nötig, alle Formulare zu öffnen, die Daten reinzurschreiben und danach die Formulare wieder zu schliessen.

    Da stellt sich das Problem, dass ein Formular, welches als UFO angezeigt wird, nicht als geöffnet gekennzeichnet wird. Wenn ich mittels 'SysCmd(acSysCmdGetObjectState, bytObjectType, strObjectName)' prüfe, gibt es 0 (=geschlossen) zurück. Da ich in einem geschlossenen Fall das Formular öffne, auslese und wieder schliesse, schliesst es mir natürlich auch das Formular, von welchem ich die Aktion ausführe.

    Ich kann natürlich das Fomular und die UFO's an die Klasse übergeben, die Formulare zum auslesen mittels 'Dim FormNochmal As New Form_DeinFormular' öffnen, was aber nicht dynamisch ist. Das ist aber unheimlich unflexibel und würde heissen, dass ich kein anderes Formular geöffnet haben darf (da es mir sonst geschlossen wird). Wie kann ich das Dynamisch gestalten?
    Die andere Variante, die Formulare nicht zu schliessen, ist nicht praktikabel.

    Kann mir da jemand weiterhelfen?


    Danke und Gruss Thomas
    Montag, 17. Oktober 2011 14:42

Antworten

  • Hallo Thomas,
    Man könnte die Batch-Datei zur Laufzeit erstellen. Man sollte aber aufpassen, weil die Shell Funktion asynchron läuft. Das Programm geht von der Shell Funktion zu der nächsten Code-Linie ohne darauf zu warten, das der Kopiervorgang durch ist.
    Man könnte eventuell nach der Shell Funktion eine Schleife bauen, die genau das prüft, ob die Datenbank kopiert wurde:
    Dim strFile As String
    
    Open "BatchDatei.bat" For Output As #101
        Print #101, "cd ""H:\Projecte"""
        Print #101, "xcopy Main*.mdb $$$$$.*"
    Close #101
    
    Shell "BatchDatei.bat"
    Do
        strFile = Dir("$$$$$.mdb", vbNormal)
    Loop Until strFile <> ""
    
    
    

     
    Viele Grüße,
    Bogdan

    Ich bin gerne bei den Foren. Es kommt von Herzen. Es wird aber keine implizite oder sonstige Garantie für die geposteten Antworte / Informationen gewährt. Hier auch die Forenregeln.
    • Als Antwort markiert Alphawolfi Mittwoch, 2. November 2011 08:21
    Dienstag, 1. November 2011 14:33
    Moderator

Alle Antworten

  • Hallo,

    ich hab das vor Jahren mal in einem Suchformular zusammengebastelt, ein bissl simpel aber das Ding leistet mir seitdem gute Dienste; ist eines der Tools das ich in alle meine Applikationen mit einbaue.

    Das Array varControls() existiert auf Formularebene.

    Das eigene Steuerungsformular nehme ich mit dem Select-Case einfach aus. Wie gesagt simpel aber es tut brav seine Dienste.

    Zur Erklärung: Ich suche einfach nach Vorkommen bestimmter Suchtexte innerhalb der Controls aller Formulare/Reports einer DB und gebe das Ergebnis in eine Listbox "lstErgebnis" aus.

    Private Sub cmdSuchen_Click()
    
    Dim objSearch As Object
    Dim objCurrent As Object
    Dim objLabel As Control
    
    Dim cntLoop As Container
    
    Dim intI As Integer
    Dim intObjectCount As Integer
    
    On Error Resume Next
    
    Me.lstErgebnis.RowSource = ""
    Me.lstErgebnis.Requery
    
    intI = 0
    
    For Each cntLoop In CurrentDb.Containers
        'MsgBox cntLoop.Name
        If cntLoop.Name = "Forms" Or cntLoop.Name = "Reports" Then
            For intObjectCount = 0 To cntLoop.Documents.Count() - 1
                Select Case cntLoop.Documents(intObjectCount).Name
                    Case "Action", Me.Name        'Ausnahmen, die nicht überprüft werden
                    Case Else
                        Select Case cntLoop.Name
                            Case "Forms"
                                DoCmd.OpenForm cntLoop.Documents(intObjectCount).Name, acViewDesign
                                DoEvents
                                Set objCurrent = Forms(cntLoop.Documents(intObjectCount).Name)
                                DoEvents
                            Case "Reports"
                                DoCmd.OpenReport cntLoop.Documents(intObjectCount).Name, acViewDesign
                                DoEvents
                                Set objCurrent = Reports(cntLoop.Documents(intObjectCount).Name)
                                DoEvents
                        End Select
                        For Each objLabel In objCurrent.Controls
                            DoEvents
                            Select Case objLabel.ControlType
                                Case acLabel
                                    If InStr(objLabel.Caption, Me.txtSuchen) Then
                                        'MsgBox objCurrent.Name & ": " & objLabel.Name
                                        intI = intI + 1
                                        ReDim Preserve varControls(3, intI)
                                        varControls(0, intI) = intI
                                        varControls(1, intI) = objCurrent.Name
                                        varControls(2, intI) = objLabel.Name
                                        varControls(3, intI) = cntLoop.Name
                                        Me.lstErgebnis.RowSource = Me.lstErgebnis.RowSource & intI & ";" & cntLoop.Name & ";Label;" & objCurrent.Name & ";" & objLabel.Name & ";"
                                    End If
                                Case acTextBox
                                    If InStr(objLabel.ControlSource, Me.txtSuchen) Then
                                        'MsgBox objCurrent.Name & ": " & objLabel.Name
                                        intI = intI + 1
                                        ReDim Preserve varControls(3, intI)
                                        varControls(0, intI) = intI
                                        varControls(1, intI) = objCurrent.Name
                                        varControls(2, intI) = objLabel.Name
                                        varControls(3, intI) = cntLoop.Name
                                        Me.lstErgebnis.RowSource = Me.lstErgebnis.RowSource & intI & ";" & cntLoop.Name & ";Textbox;" & objCurrent.Name & ";" & objLabel.Name & ";"
                                    End If
                            End Select
                        Next objLabel
                        DoEvents
                        Select Case cntLoop.Name
                            Case "Forms"
                                DoCmd.Close acForm, objCurrent.Name, acSavePrompt
                            Case "Reports"
                                DoCmd.Close acReport, objCurrent.Name, acSavePrompt
                        End Select
                        DoEvents
                End Select
            Next intObjectCount
        End If
    Next
    
    Me.lstErgebnis.Requery
    
    End Sub
    
    

    Bei weiteren Fragen einfach nochmal posten.

    Viel Erfolg!


    Regards, Ralph
    • Bearbeitet Ralph J. Moeller Montag, 17. Oktober 2011 14:56 Erklärung erweitert
    Montag, 17. Oktober 2011 14:54
  • Hallo Ralph

    Danke für Deinen Beitrag. Das ist mir soweit schon klar, aber nicht ganz meine Frage.
    Meine Datenbank kann auch alle Objekte aus einer anderen DB als der Aktuellen auslesen. Zum öffnen benutze ich folgenden Code (der auch Funktioniert):

    Private Sub subOtherDBOpen(DBPathAndName)
    
    10  On Error GoTo Err_subOtherDBOpen
    20  If DBPathAndName <> vbNullString Then
    30      Set mp_appOpenDB = fGetRefNoAutoexec(DBPathAndName)
    40  End If
    
    50  DoEvents
    70  Debug.Print mp_appOpenDB.CurrentProject.Name
    
    Exit_subOtherDBOpen:
    90  On Error GoTo 0
    100 Exit Sub
    
    Err_subOtherDBOpen:
    110 Call fctErrorHandler("clsObject", "subOtherDBOpen")
    120 Resume Exit_subOtherDBOpen
    End Sub
    

    fGetRefNoAutoexec ist dabei der Code von Dev Ashish:

    Private Function fGetRefNoAutoexec(ByVal strMDBPath As String) As Access.Application
        
        Dim objAcc As Access.Application
        Dim TIdSrc As Long, TIdDest As Long
        Dim abytCodesSrc(0 To 255) As Byte
        Dim abytCodesDest(0 To 255) As Byte
    
    40  If (Len(Dir$(strMDBPath)) = 0) Then
    50      Err.Raise 53
    60  End If
    
    70  Set objAcc = New Access.Application
    80  With objAcc
    
            ' attach to process
    90      TIdSrc = GetWindowThreadProcessId(Application.hWndAccessApp, ByVal 0)
    100     TIdDest = GetWindowThreadProcessId(.hWndAccessApp, ByVal 0)
    
    110     If CBool(AttachThreadInput(TIdSrc, TIdDest, True)) Then
    120         Call SetForegroundWindow(.hWndAccessApp)
    130         Call SetFocusAPI(.hWndAccessApp)
    
                ' Set Shift state
    140         Call GetKeyboardState(abytCodesSrc(0))
    150         Call GetKeyboardState(abytCodesDest(0))
    160         abytCodesDest(VK_SHIFT) = 128
    170         Call SetKeyboardState(abytCodesDest(0))
    
                ' Open a mdb with Autoexec
    180         Call .OpenCurrentDatabase(strMDBPath, False)
    
                ' Revert back keyboard state
    190         Call SetKeyboardState(abytCodesSrc(0))
    200     End If
            ' release
    210     Call AttachThreadInput(TIdSrc, TIdDest, False)
    220     Call SetForegroundWindow(Application.hWndAccessApp)
    230     Call SetFocusAPI(Application.hWndAccessApp)
    
    240 End With
    250 Set fGetRefNoAutoexec = objAcc
    260 Set objAcc = Nothing
    
    270 Exit Function
    
    ErrHandler:
    290 If (TIdDest) Then Call AttachThreadInput(TIdSrc, TIdDest, False)
    300 Call SetForegroundWindow(Application.hWndAccessApp)
    310 On Error GoTo 0
    
    End Function


    Das funktioniert auch hervorragend. Jetzt habe ich gedacht, dass ich ja auch die aktuelle Datenbank so öffnen kann. Dann generiert es mir aber in der Zeile 180 den Err.Number 7866 (Desc: "Microsoft Office Access can't open the database because it is missing, or opened exclusively by another user.") Missing ist sie ja sicher nicht. Deswegen funktioniert dann in der Zeile 70 des ersten Listings das Auswerten nicht. Somit kann ich natürlich nachfolgend auch nicht auf CurrentProject und die damit verbundenen Eigenschaften zugreifen.
    Bleibt noch die Klärung von Exklusiv oder nicht. Wenn ich unter Tools -> Options unter dem Register 'Advanced' schauen gehe, steht beim 'Default open mode' 'Shared'. Ich öffne die Datenbank jeweils einfach per Doppelklick. Da sollte sich doch nicht exklusiv geöffnet werden, oder?

    Kann mir da jemand weiterhelfen? Die DB in einen neuen Prozess zu öffnen wäre die Lösung meiner Frage.

     

     

     


    Danke und Gruss Thomas
    Dienstag, 18. Oktober 2011 14:27
  • Hallo,

    Alphawolfi wrote:

    [...]
    70    Debug.Print mp_appOpenDB.CurrentProject.Name

    Das funktioniert auch hervorragend. Jetzt habe ich gedacht, dass ich ja
    auch die aktuelle Datenbank so öffnen kann.

    Wenn du das Application-Objekt weglaesst, bezieht sich CurrentProject auf
    die aktuelle DB. Oeffnen brauchst du sie kein zweitesmal. Also:

    Debug.Print CurrentProject.Name

    Gruss - Peter


    Mitglied im http://www.dbdev.org
    FAQ: http://www.donkarl.com

    Dienstag, 18. Oktober 2011 17:20
    Moderator
  • Hallo Alphawolfi,

    oder - ganz konkret - die aktuelle Datenbank-Datei duplizieren (in gleichem Pfad kopieren) und dann die Kopie öffnen?  

    Viele Grüße,

    Bogdan


    Ich bin gerne bei den Foren. Es kommt von Herzen. Es wird aber keine implizite oder sonstige Garantie für die geposteten Antworte / Informationen gewährt. Hier auch die Forenregeln.
    Dienstag, 25. Oktober 2011 12:47
    Moderator
  • Hallo

    Danke für die Antwort. Hmm, das wäre eine Idee. Ich werde mir das 'mal überlegen.
    Was mir eben erst in den Sinn kommt: Ich kann im Code alle geöffneten Formulare in eine Collection einfügen, danach den Code ausführen und die Formulare wieder aus der Collection auslesen und öffnen. Wenn jemand noch eine bessere Idee hat: Gerne hier posten. Danke.

    Allerdings verstehe ich trotzdem noch nicht, weshalb ich auch die geöffnete DB nicht als neue Instanz nochmals öffnen kann. Kann mir da jemand weiterhelfen?


    Danke und Gruss Thomas
    Dienstag, 25. Oktober 2011 13:29
  • Ich habe das Ganze 'mal mit dem Kopieren versucht.

    Versuch 1: FileCopy. Da bringt Access die Meldung, dass der Zugriff verweigert wurde.

    Versuch 2: Batchfile mit der einen Zeile:

    xcopy Main*.mdb $$$$$.*

    Wenn ich dieses Batchfile von Hand ausführe, dann macht er mir genau das, was ich will (vor der Anweisung steht dann "H:\Projekte...": Im aktuellen Verzeichnis die Datei zu kopieren. Wenn ich per Shell-Anweisung aus Access die Datei ausführen möchte, wird die Batchdatei ausgeführt, allerdings findet er nichts, da vor der Anweisung "D:\Documents..." steht und er dort natürlich keine Main*.mdb findet?!?!? Die Accessdatei, von welcher ich die Batchdatei starte, ist im gleichen Verzeichniss wie die Batchdatei.
    Natürlich kann ich in der Batchdatei den fixen Pfad angeben, aber genau das will ich nicht.

    Kann da jemand weiterhelfen? Ich dreh' langsam durch. Ich kriege es einfach nicht heraus, weshalb die gleiche Batchdatei, von unterschiedlichen Programmen gestartet, sich anders verhält.


    Danke und Gruss Thomas
    • Als Antwort markiert Alphawolfi Mittwoch, 2. November 2011 08:21
    • Tag als Antwort aufgehoben Alphawolfi Mittwoch, 2. November 2011 08:21
    Dienstag, 25. Oktober 2011 19:31
  • Hallo Thomas,
    Man könnte die Batch-Datei zur Laufzeit erstellen. Man sollte aber aufpassen, weil die Shell Funktion asynchron läuft. Das Programm geht von der Shell Funktion zu der nächsten Code-Linie ohne darauf zu warten, das der Kopiervorgang durch ist.
    Man könnte eventuell nach der Shell Funktion eine Schleife bauen, die genau das prüft, ob die Datenbank kopiert wurde:
    Dim strFile As String
    
    Open "BatchDatei.bat" For Output As #101
        Print #101, "cd ""H:\Projecte"""
        Print #101, "xcopy Main*.mdb $$$$$.*"
    Close #101
    
    Shell "BatchDatei.bat"
    Do
        strFile = Dir("$$$$$.mdb", vbNormal)
    Loop Until strFile <> ""
    
    
    

     
    Viele Grüße,
    Bogdan

    Ich bin gerne bei den Foren. Es kommt von Herzen. Es wird aber keine implizite oder sonstige Garantie für die geposteten Antworte / Informationen gewährt. Hier auch die Forenregeln.
    • Als Antwort markiert Alphawolfi Mittwoch, 2. November 2011 08:21
    Dienstag, 1. November 2011 14:33
    Moderator
  • Hallo Bogdan

    Herzlichen Dank für die Antwort.

    Das scheint die Lösung zu sein. Wenn ich Deinen Code mit Variablen ergänze, funktioniert er immer noch bestens.


    Danke und Gruss Thomas
    Mittwoch, 2. November 2011 08:21