z.B.:
-----
- Feld "Strasse"
"EventProcPrefix": "Strasse", "Name": "Strasse", "ControlType": 109, "ControlSource": "Strasse", "DecimalPlaces": 255, "StatusBarText": "AdrZl3", "EnterKeyBehavior": "Falsch", "AllowAutoCorrect": "Wahr", "Visible": "Wahr", "DisplayWhen": 0, "Vertical": "Falsch", "Enabled": "Wahr", "Locked": "Falsch", "FilterLookup": 1, "AutoTab": "Falsch", "TabStop": "Wahr", "TabIndex": 4, "ScrollBars": 0, "Left": 1814, "Top": 1814, "Width": 3515, "Height": 340, "ForeColor": 0, "TextAlign": 0, "ColumnWidth": -1, "ColumnOrder": 0, "ColumnHidden": "Falsch", "Section": 0, "InSelection": "Falsch", "LineSpacing": 0
Wenn man die Details einfangen kann,
bekommt man z.B. einen Formularentwurf.
( alternativ mit Textdateien per backupMod.bas )
--> https://jobst-software.com/forms11.gif
--> https://jobst-software.com/download/backupMod.bas
##2071 demo-online -- (Script)
z.B.:
-----
Eine Tabelle mit
- Anwendungsnamen
- Objekt-Typ
- Objekt-Namen
- Feld-namen
- Eigenschaften
generieren.
AcApp AcObjType AcObj AcFd AcProps
--------------------------------------------------------
...
fri Form Adress-Pflege Strasse "Name": "Strasse", ...
fri Form Adress-Pflege Plz "Name": "Plz", ...
...
Public Function accweb_AcObjs_to_Tab()
Dim dbs As Database
Set dbs = DBEngine(0)(0)
Dim not_propNames As String
Let not_propNames = "DateCreated, LastUpdated, ..."
Dim acFds As Recordset
Set acFds = dbs.OpenRecordset("SELECT * from AcFds")
accweb_AcObj_to_Tab dbs, "Table", dbs.TableDefs, not_propNames, acFds
accweb_AcObj_to_Tab dbs, "Query", dbs.QueryDefs, not_propNames, acFds
accweb_AcObj_to_Tab dbs, "Form", dbs.Containers("Forms").Documents, not_propNames, acFds
accweb_AcObj_to_Tab dbs, "Report", dbs.Containers("Reports").Documents, not_propNames, acFds
acFds.Close
Set acFds = Nothing
End Function
Sub addAcFds_rec(dbs As Database, acFds As Recordset, acObjType As String, acObj_Name As String, fd_Name As String, props As String)
acFds.AddNew
acFds("AcApp") = dbs.Name
acFds("AcObjType") = acObjType
acFds("AcObj") = acObj_Name
acFds("AcFd") = fd_Name
acFds("AcProps") = props
acFds.Update
End Sub
Sub accweb_AcObj_to_Tab(dbs As Database, acObjType As String, acObjs, not_propNames As String, acFds As Recordset)
On Error GoTo Err_exportAll
Dim curState As String
Let curState = ""
Dim eleName As String
Let eleName = ""
Dim acEle_i As Integer
For acEle_i = 0 To acObjs.Count - 1
If Left(acObjs(acEle_i).Name, 1) <> "~" Then
Dim acObj As Object
Set acObj = acObjs(acEle_i)
eleName = acObj.Name
Dim r As String
Let r = parseAcObj_Properties(acObj.Properties, not_propNames)
addAcFds_rec dbs, acFds, acObjType, eleName, "-", r
Debug.Print acObjType & " -- " & r
Debug.Print
If acObjType = "Form" Then DoCmd.OpenForm eleName, acDesign
If acObjType = "Report" Then DoCmd.OpenReport eleName, acViewDesign
Dim ctrs
Set ctrs = Nothing
If acObjType = "Form" Then Set ctrs = Forms(eleName).Controls
If acObjType = "Report" Then Set ctrs = Reports(eleName).Controls
If Not (ctrs Is Nothing) Then
Dim c_i As Integer
For c_i = 0 To (ctrs.Count - 1)
Dim c As Object
Set c = ctrs(c_i)
Dim c_r As String
Let c_r = parseAcObj_Properties(c.Properties, not_propNames)
addAcFds_rec dbs, acFds, acObjType, acObj.Name, c.Name, c_r
Debug.Print eleName & " -- " & c_r
Debug.Print
Next
End If
If acObjType = "Form" Then DoCmd.Close acForm, eleName
If acObjType = "Report" Then DoCmd.Close acForm, eleName
curState = "eleName=" & eleName & "."
End If
Next acEle_i
Exit Sub
Err_exportAll:
Dim dlgRes As Integer
Let dlgRes = MsgBox(Error & " " & Err & " in '" & curState & "'", 48 Or 2)
If dlgRes = 5 Then
Resume Next
ElseIf dlgRes = 4 Then
Resume
End If
Exit Sub
End Sub
Public Function parseAcObj_Properties(o, not_propNames As String)
Dim res As String
Let res = ""
Dim p_i As Integer
For p_i = 0 To (o.Count - 1)
Dim p As Object
Set p = o(p_i)
Dim propName As String
Let propName = p.Name
If InStr(propName, "Border") = 1 Or InStr(propName, "Is") = 1 Or InStr(propName, "Can") = 1 Or InStr(propName, "Old") = 1 Or InStr(propName, "Special") = 1 Then
Rem ign.
ElseIf InStr(propName, "Back") = 1 Then
Rem ign.
ElseIf InStr(propName, "Font") >= 1 Or InStr(propName, "Margin") >= 1 Then
Rem ign.
ElseIf InStr(", " & not_propNames & ",", ", " & propName) = 0 Then
Dim v
Let v = Null
On Error Resume Next
v = p.value
If Err = 0 Then
Dim t As String
Let t = valQte(v)
If t <> "" Then
res = res & IIf(res = "", "", ", ") & Chr(34) & propName & Chr(34) & ": " & t
End If
End If
On Error GoTo 0
End If
Next p_i
parseAcObj_Properties = res
End Function
Public Function valQte(v) As String
Dim res As String
Let res = ""
If Not IsEmpty(v) Then
If Not IsNull(v) Then
If IsNumeric(v) And IsNumeric("" & v) Then
res = "" & v
ElseIf v <> "" Then
res = Chr(34) & Replace("" & v, Chr(34), "'") & Chr(34)
End If
End If
End If
valQte = res
End Function
- 1 - (TxtDoc--1013-2025-11-30.html)