1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
Option Compare Database
Option Explicit
Dim dbs As DAO.Database
Dim prt As DAO.Property
Dim tbl As DAO.TableDef
Dim zapr As DAO.QueryDef
Dim fld As DAO.Field
Dim ref As Reference
Dim doc As Document
Dim cnt As Control
Dim mdl As Module
Dim frm As Form
Dim rpt As Report
Dim j1, j2, s1, s2, s3, s4, n1, n2, n3
Dim szag
Sub a_pech_mod140110()
Reset
Dim sname
Open CurrentDb.Name & "f" For Output As #3
Print #3, "<html>"
Print #3, "<meta http-equiv='Content-Type' content='text/html; charset=windows-1251' />"
Print #3, "<style>"
Print #3, "pre{font-family:courier;font-size:14pt;"
Print #3, "</style>"
Print #3, "<pre>"
Set dbs = CurrentDb
szag = "'" & Now() & "= = " & dbs.Name & " = ="
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, szag
For Each prt In dbs.Properties
If prt.Type = 0 Then
Print #3, "BP=", prt.Type, prt.Name
Else
Print #3, "BP=", prt.Type, prt.Name, prt.Value
End If
'.Name, prt.Value
Next prt
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'References="; szag
For Each ref In References
Print #3, ref.Name, ref.FullPath
Next ref
'''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'SCRIPTS="; szag
For Each doc In dbs.Containers("SCRIPTS").Documents
n1 = doc.Name
'Print #3, "'\\ "
Print #3, "MK=", n1
Next doc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "TableDefs="; szag
For Each tbl In dbs.TableDefs
n1 = tbl.Name
n2 = "-" & tbl.Connect
Debug.Print tbl.Name
'Print #1, "'\\ "
If Mid(n1, 1, 4) = "MSys" Then
''
ElseIf Len(n2) > 1 Then
Print #3, ""
Print #3, "``t=", n1
Print #3, "\\Connect=", n2
Else
Print #3, ""
Print #3, "``t=", n1; " записей="; tbl.RecordCount; " \\" & tbl.ValidationText
n2 = ""
n3 = ""
Dim n4r, n4d
n3 = Chr(13) & Chr(10)
'''''''''''''''''''
For Each fld In tbl.Fields
n4d = " //"
n4r = " //"
'On Error Resume Next
Print #3, "`"; fld.Name; "`"; fld.Type; "`"; fld.Size
Debug.Print "`"; fld.Name; "`"; fld.Type; "`"; fld.Size
'fld.d
'n4r = n4r & fld.Properties("RowSource")
'n4d = n4d & fld.Properties("Description")
'On Error GoTo err00
'If Len(n4r) > 3 And Len(n4r) < 2000 Then
'Print #3, "`---подстановка= "; n4r
'End If
'If Len(n4d) > 3 And Len(n4d) < 2000 Then
'Print #3, "`===примечание= "; n4d
'End If
n2 = s1
Next fld
End If
Next tbl
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'QueryDefs="; szag
For Each zapr In dbs.QueryDefs
n1 = zapr.Name
On Error Resume Next
n2 = "\\"
n2 = " " & zapr.SQL
On Error GoTo err00
'Print #3, "'\\ "
Print #3, ""
Print #3, "``z=", n1
Print #3, n2
Next zapr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, "'forms="; szag
For Each doc In dbs.Containers("forms").Documents
n1 = doc.Name
DoCmd.OpenForm n1, acDesign, , , acFormReadOnly, acHidden
Print #3, "'\\ ==============================="
Print #3, "``F=", n1
Print #3, "источник\\RecordSource="; Forms(n1).RecordSource
n2 = ""
n3 = ""
n3 = Chr(13) & Chr(10)
'On Error Resume Next
Print #3, ""
'Print #3, "'forms="; szag
For Each cnt In Forms(n1).Controls
s1 = cnt.ControlType
Debug.Print s1
s2 = cnt.Name
Debug.Print s1, s2
s3 = "\\"
'On Error Resume Next
If s1 = acTextBox Then
s3 = cnt.ControlSource
End If
s4 = "\\"
If s1 = acLabel Then
s4 = cnt.Caption
End If
Debug.Print s1, s2, s3, s4
s1 = n2 & "`" & s1 & "`" & s2 & "`" & s3 & "`" & s4 & n3
n2 = s1
Next cnt
Print #3, n2
Set mdl = Forms(n1).Module
Print #3, "'\\ "
Print #3, "``модуль формы="; n1; " линий="; mdl.Lines(1, 99999)
DoCmd.Close acForm, n1, acSaveNo
Next doc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, "'reports="; szag
For Each doc In dbs.Containers("reports").Documents
n1 = doc.Name
DoCmd.OpenReport n1, acViewDesign, , , acHidden
Print #3, "'\\ ================================"
Print #3, "``R=", n1
Print #3, "источник\\RecordSource="; Reports(n1).RecordSource
n2 = ""
n3 = ""
n3 = Chr(13) & Chr(10)
For Each cnt In Reports(n1).Controls
s1 = cnt.ControlType
Debug.Print s1
s2 = cnt.Name
Debug.Print s1, s2
s3 = "\\"
'On Error Resume Next
If s1 = acTextBox Then
s3 = cnt.ControlSource
End If
s4 = "\\"
If s1 = acLabel Then
s4 = cnt.Caption
End If
Debug.Print s1, s2, s3, s4
s1 = n2 & "`" & s1 & "`" & s2 & "`" & s3 & "`" & s4 & n3
n2 = s1
Next cnt
Print #3, n2
Set mdl = Reports(n1).Module
Print #3, "'\\ "
Print #3, "``модуль отчета=", n1, ; " линий="; mdl.Lines(1, 99999)
DoCmd.Close acReport, n1, acSaveNo
Next doc
On Error GoTo 0
'On Error GoTo err00
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Print #3, ""
Print #3, "'modules="; szag
For Each doc In dbs.Containers("modules").Documents
n1 = doc.Name
DoCmd.OpenModule n1
Set mdl = Modules(n1)
Print #3, "'\\ "; szag
'Print #3, "modules=", n1
Print #3, "``modules="; n1; " линий="; mdl.CountOfLines
'Print #1, "'\\"
Print #3, mdl.Lines(1, 99999)
DoCmd.Close acModule, n1
'Next doc
Next doc
Print #3, "'\\fin"
Close #3
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MsgBox " описание базы в формате НТМ :" & CurrentDb.Name & "f"
Exit Sub
err00:
MsgBox Err.Number & " " & Err.Description
Err.Clear
Resume Next
End Sub
