title image


Smiley Re: Ein klassisches Proble
Hi,



ich hatte auch mal das Problem. Ích habe mir wie folgt geholfen:



Exportiere die Namen der Tabellen udn Abfragen in eine Tabelle. Diese Tabelle rbaucht nur eine Spalte für den Namen des Objekts zu haben. Jede Tabelle und Abfrage taucht dort nur mit ihrem Namen auf. Für diese Aufgabe kannst Du die unten angehängten Funktionen ShowTables und ShowQueries benutzen.



Eine VBA-Routine geht die Tabelle durch und benutzt jeden Satz nacheinander als Suchkriterium. Der Tabellen/Abfragenname wird in den Abfrage-SQLs, in den Formularen (inkl. Steuerelementen), Berichten (inkl. Steuerelementen) und im Code gesucht. Die Treffer werden mit "Fundort" und weiteren Angaben in eine Textfile geschrieben, dass dann die Abhängigkeiten ausgibt. Diese Textdatei kannst Du dann auch in Access importieren und auswerten. Diese segensreiche Routine ist ShowDependencies() und hängt ebenfalls an.





'Wegschreiben der TABELLENnamen in eine Tabelle

Function ShowTables()

Dim i

Dim Tablename As String



For Each i In CurrentDb.TableDefs

Tablename = i.Name

CurrentDB.Execute "INSERT INTO Zieltabelle VALUES ('" & Tablename & "')"

Next i

End Function







'Wegschreiben der ABFRAGENnamen in eine Tabelle

Function ShowQueries()

'Ausgaben, die mit ~ beginnen, sind SQL-Strings von Controls in

'Formularen und Berichten, Sätze ohne ~ sind echte Abfragen.

Dim i

Dim Queryname As String



For Each i In CurrentDb.QueryDefs

Queryname = i.Name

CurrentDB.Execute "INSERT INTO Zieltabelle VALUES ('" & queryname & "')"

Next i

End Function





Nach Aufruf dieser Funktionen sollten die Tabellennamen und Abfragen in der Tabelle "Zieltabelle" im (einzigen) Feld stehen. Diese Tabelle musst Du zuvor selbst anlegen, das einzige Feld muss ein Textfeld sein und kann einen beliebigen Namen haben.





Und dann kannst Du auslesen:





'Auslesen der Abhängigkeiten.

Public Function ShowDependencies(strDatei As String, strTabelle As String)

'Aus der übergebenen Tabelle, die nur ein Feld (Name beliebig) enthalten darf, werden die Sätze ausgelesen und wie folgt gesucht:

'* in den Abfragen: als Teil der SQL

'* in allen Formularen und Berichten: als Teil der Datensatzherkunft

'* in den Controls aller Formulare und Berichte: als Teil des Steuerelementinhalts

'* im VBA-Code von Modulen, Formularen und Berichten: als Bestandteile von Codezeilen

'Die Treffer werden in die neu erzeugte Textdatei des übergebenen Namens geschrieben.



Dim Mdl, frm As Form, Doc As Document, _

db As Database, Cont As Container, _

Lin As Long, rpt As Report, ref

Dim qry As QueryDef

Dim ctl As Control





Dim rstSuche As DAO.Recordset

Dim strObjekt As String

Dim strZeile As String



Set rstSuche = CurrentDb.OpenRecordset(strTabelle)

If Not rstSuche.EOF Then

rstSuche.MoveLast

End If

If rstSuche.RecordCount = 0 Then

MsgBox "Keine Suchekriterien!"

rstSuche.Close

Set rstSuche = Nothing

Exit Function '------------------------------------------------------------------------------------------------------------------------------->Exit

Else

rstSuche.MoveFirst

End If





'Sicherstellen der Existenz der Datei

If Dir(strDatei) "" Then

If MsgBox("Datei existiert bereits. Überschreiben?", vbYesNo + vbDefaultButton1, "Überschreiben?") = vbYes Then

Kill strDatei

Else

rstSuche.Close

Set rstSuche = Nothing

Exit Function '--------------------------------------------------------------------------------------------------------------------------->Exit

End If

End If



'Datei anlegen und Überschriften eindrucken

Open strDatei For Append As #1

Print #1, "Verzeichnis der Abhängigkeiten"

Print #1, 'leerzeile

Print #1, "Suchbegriff;Fundobjekttyp;Fundobjektname;"



Set db = CurrentDb



Do

strObjekt = rstSuche.Fields(0).Value



'Suchbegriff in Abfragen suchen

For Each qry In CurrentDb.QueryDefs

If qry.SQL Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Query;" & qry.Name & ";SQL"

End If

Next qry







'Suchbegriff in Formularen (Datensatzherkunft, Controlsource und Code) suchen

Set Cont = db.Containers!Forms

For Each Doc In Cont.Documents

DoCmd.OpenForm Doc.Name, acDesign, , , , acHidden

Set frm = Forms(Doc.Name)



'Formularcode durchsuchen

For Lin = 1 To frm.Module.CountOfLines 'alle Zeilen des Moduls (Zählung beginnt mit 1)

strZeile = frm.Module.Lines(Lin, 1)

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Form;" & frm.Name & ";Code;" & frm.Module.ProcOfLine(Lin, vbext_pk_Proc)

End If

Next Lin



'Formulareigenschaft "Datensatzherkunft" untersuchen

strZeile = frm.RecordSource

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Form;" & frm.Name & ";Recordsource"

End If



'Control-Recordsources untersuchen. Da nicht jedes Control eine solche hat, Fehlerignoranz einschalten!

For Each ctl In frm.Controls

strZeile = "" 'damit bei ungebundenen Controls die Controlsource des vorigen Controls nicht "nachwirkt"

On Error Resume Next

strZeile = ctl.ControlSource

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Form;" & frm.Name & ";Control;" & ctl.Name & ";Controlsource"

End If

On Error GoTo 0

Next ctl



DoCmd.Close acForm, Doc.Name, acSaveNo

Next Doc









'Suchbegriff in Berichten (Datensatzherkunft, Controlsource und Code) suchen

Set Cont = db.Containers!Reports

For Each Doc In Cont.Documents

DoCmd.OpenReport Doc.Name, acDesign

Set rpt = Reports(Doc.Name)

For Lin = 1 To rpt.Module.CountOfLines 'alle Zeilen des Moduls (Zählung beginnt mit 1)

strZeile = rpt.Module.Lines(Lin, 1)

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Report;" & rpt.Name & ";Code;" & rpt.Module.ProcOfLine(Lin, vbext_pk_Proc)

End If

Next Lin



'Report "Datensatzherkunft" untersuchen

strZeile = rpt.RecordSource

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Report;" & rpt.Name & ";Recordsource"

End If



'Control-Recordsources untersuchen. Da nicht jedes Control eine solche hat, Fehlerignoranz einschalten!

For Each ctl In rpt.Controls

strZeile = "" 'damit bei ungebundenen Controls die Conttrolsource des vorigen Controls nicht "nachwirkt"

On Error Resume Next

strZeile = ctl.ControlSource

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Report;" & rpt.Name & ";Control;" & ctl.Name & ";Controlsource"

End If

On Error GoTo 0

Next ctl

DoCmd.Close acReport, Doc.Name, acSaveNo

Next Doc









'Suchbegriff in "echten" Modulen suchen (Formular- und Berichts module sind bereits verarbeitet)

For Mdl = 0 To Modules.Count - 1

If Modules(Mdl).Type = acStandardModule Then

For Lin = 1 To Modules(Mdl).CountOfLines 'alle Zeilen des Moduls (Zählung beginnt mit 1)

'strZeile = Left(Modules(Mdl).Lines(Lin, 1), InStrRev(Modules(Mdl).Lines(Lin, 1), "'")) 'Kommentare abschneiden

strZeile = Modules(Mdl).Lines(Lin, 1)

If strZeile Like "*" & strObjekt & "*" Then

Print #1, strObjekt & ";Module;" & Modules(Mdl).Name & ";" & Modules(Mdl).ProcOfLine(Lin, vbext_pk_Proc)

End If

Next Lin

End If

Next Mdl



rstSuche.MoveNext





Loop Until rstSuche.EOF

Close 1

rstSuche.Close

Set rstSuche = Nothing

Set db = Nothing



End Function







Grüßle

Martin
Atrus2711 ät gmx punkt net
Meine Beiträge zu MS Office betreffen stets Version 2000,
wenn nicht anders angegeben.




geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: