Auflistung aller Objekte

Question

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

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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.

Answer 5

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

Answer 6

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

Answer 7

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.

Answer 8

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