Делимся наработками - MS Access - Ответ 2479961
11.02.2012, 16:26. Показов 413388. Ответов 251
Ответ
Порой наступает такой момент, что в базе нужно что-то изменить, но уже не помнишь всех связей или никогда не знал, поскольку правишь чужой проект.
На такой случай сделал две формы.
1-я) Осуществляет поиск чего-либо в текстах всех запросов, сохранённых в базе и в источниках строк полей таблиц, если есть подстановочные поля.
2-я) Ищет формы и их элементы, в которых использованы те или иные запросы.
За одно, в них реализован "массовый" поиск неиспользуемых запросов.
В атаче архив базы, сделанной в 2010-м аксесе.
(в 2003-й не получилось сохранить)
Для тех, кто не сможет открыть этот файл:
- Текст первой формы
Form_frmAdmLookForQuery.cls
| Visual Basic | 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
231
232
233
234
235
236
237
| VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Form_frmAdmLookForQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Private Const coTitle As String = "Поиск запросов"
Private Sub cmdLookAll_Click()
If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _
& "Это может занять значительное время." _
, vbYesNo + vbQuestion, coTitle) _
Then Exit Sub
Dim blnPresent As Boolean
Dim blnRS As Boolean
Dim blnRST As Boolean
Dim fld As Field
Dim objQueryLF As QueryDef
Dim objQueryLI As QueryDef
Dim prp As Property
Dim strLookFor As String
Dim strQueryName As String
Dim strSQL As String
Dim strTabName As String
Dim td As TableDef
On Error GoTo ErrorHandler
' отключаем обновление экрана
Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _
& "Это может занять значительное время. Подождите..."
' очищаем список запросов перед поиском
Me.lstQuery.RowSource = ""
' ищем запросы в запросах, сохранённых в базе
Me.lstQuery.AddItem "----- Начало списка -----"
For Each objQueryLF In CurrentDb.QueryDefs
strLookFor = objQueryLF.Name
If Left(strLookFor, 1) <> "~" Then
blnPresent = False
' перечитываем запросы, сохранённые в базе
For Each objQueryLI In CurrentDb.QueryDefs
strQueryName = objQueryLI.Name
If Left(strQueryName, 1) <> "~" Then
' если запрос содержит в теле искомую строку
If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then
' отмечаем, что данный запрос используется
blnPresent = True
Exit For
End If
End If
Next objQueryLI
' если искомый запрос не обнаружен
If Not blnPresent Then
' добавляем имя запроса в список, если ренее не добавили
Call AddInListBox(strLookFor, strLookFor)
End If
End If
Next objQueryLF
' ищем запросы в таблицах, сохранённых в базе
Me.lstQuery.AddItem "----- Конец списка -----"
For Each objQueryLF In CurrentDb.QueryDefs
strLookFor = objQueryLF.Name
If Left(strLookFor, 1) <> "~" Then
' перечитываем все таблицы, сохранённые в базе
For Each td In CurrentDb.TableDefs
strTabName = td.Name
If Left(strTabName, 4) <> "MSys" _
And Left(strTabName, 4) <> "USys" _
And Left(strTabName, 7) <> "tblSinc" _
Then
For Each fld In td.Fields
blnRS = False
blnRST = False
For Each prp In fld.Properties
If prp.Name = "RowSourceType" Then blnRST = True
If prp.Name = "RowSource" Then blnRS = True
Next prp
' если это подстановочное поле
If blnRS And blnRST Then
' если источник строк содержит искомую строку
If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then
' отмечаем, что данный запрос используется
blnPresent = True
Exit For
End If
End If
Next fld
' если искомый запрос обнаружен
If blnPresent Then
' удаляем имя запроса из списка
Me.lstQuery.RowSource = Replace(Me.lstQuery.RowSource, ";" & strQueryName & ";", ";")
End If
End If
Next td
End If
Next objQueryLF
' включаем обновление экрана
Application.Echo True, "Получение свойств завершено."
MsgBox "Обработка окончена", , coTitle
Exit Sub
ErrorHandler:
Call ErrMsg(Me.Caption) ' матюгальник
Resume Next
End Sub
Private Sub cmdLookFor_Click()
' получаем список запросов, содержащих введённый текст, а также
' таблиц и их полей, у которых источник строк содержит введённый текст
'If vbYes <> MsgBox("Произвести поиск запросов по образцу?" _
' , vbYesNo + vbQuestion, coTitle) _
'Then Exit Sub
Dim blnRS As Boolean
Dim blnRST As Boolean
Dim fld As Field
Dim objQueryLI As QueryDef
Dim prp As Property
Dim strLookFor As String
Dim strQueryName As String
Dim strSQL As String
Dim strTabName As String
Dim td As TableDef
On Error GoTo ErrorHandler
strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)
If strLookFor <> "" Then
' отключаем обновление экрана
Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."
' очищаем список запросов перед поиском
Me.lstQuery.RowSource = ""
' получаем список запросов, содержащих введённый текст
Me.lstQuery.AddItem "----- Запросы -----"
' перечитываем все запросы, сохранённые в базе
For Each objQueryLI In CurrentDb.QueryDefs
strQueryName = objQueryLI.Name
If Left(strQueryName, 1) <> "~" Then
' если запрос содержит в теле искомую строку
If InStr(1, objQueryLI.SQL, strLookFor, vbTextCompare) > 0 Then
' добавляем имя запроса в список, если ренее не добавили
Call AddInListBox(strQueryName, strQueryName)
End If
End If
Next objQueryLI
' получаем список таблиц и их полей, у которых источник строк содержит введённый текст
Me.lstQuery.AddItem "----- Таблицы -----"
' перечитываем все таблицы, сохранённые в базе
For Each td In CurrentDb.TableDefs
strTabName = td.Name
If Left(strTabName, 4) <> "MSys" _
And Left(strTabName, 4) <> "USys" _
And Left(strTabName, 7) <> "tblSinc" _
Then
For Each fld In td.Fields
blnRS = False
blnRST = False
For Each prp In fld.Properties
If prp.Name = "RowSourceType" Then blnRST = True
If prp.Name = "RowSource" Then blnRS = True
Next prp
' если это подстановочное поле
If blnRS And blnRST Then
' если источник строк содержит искомую строку
If InStr(1, fld.Properties("RowSource").Value, strLookFor, vbTextCompare) > 0 Then
' добавляем имя таблицы в список, если ренее не добавили
Call AddInListBox(strTabName, strTabName)
' добавляем имя поля в список, если ренее не добавили
Call AddInListBox(fld.Name, ". " & fld.Name)
End If
End If
Next fld
End If
Next td
' включаем обновление экрана
Application.Echo True, "Получение свойств завершено."
MsgBox "Обработка окончена", , coTitle
Else
MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _
, vbExclamation, coTitle
End If
Exit Sub
ErrorHandler:
Call ErrMsg(Me.Caption) ' матюгальник
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.txbLookFor.Value = Null
Me.lstQuery.RowSource = ""
End Sub
Private Function AddInListBox( _
strLookFor As String _
, strAdd As String _
) As Boolean
On Error GoTo ErrorHandler
If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then
Me.lstQuery.AddItem strAdd
AddInListBox = True
Else
AddInListBox = False
End If
Exit Function
ErrorHandler:
Call ErrMsg(Me.Caption) ' матюгальник
Resume Next
End Function |
|
- Текст второй формы
Form_frmAdmLookForQueryOnForm.cls
| Visual Basic | 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
| VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Form_frmAdmLookForQueryOnForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Const coTitle As String = "Поиск форм и их элементов"
Private Sub cmdLookAll_Click()
If vbYes <> MsgBox("Получить список имён неиспользуемых запросов? " & vbCr _
& "Это может занять значительное время." _
, vbYesNo + vbQuestion, coTitle) _
Then Exit Sub
Dim blnPresent As Boolean
Dim ctl As Control
Dim objFrm As AccessObject
Dim prp As Property
Dim q As Long
Dim strObjName As String
Dim strSource As String
Dim strLookFor As String
On Error GoTo ErrorHandler
' отключаем обновление экрана
Application.Echo False, "Идёт получение списка имён неиспользуемых запросов. " _
& "Это может занять значительное время. Подождите..."
' очищаем список запросов перед поиском
Me.lstQuery.RowSource = ""
For q = 0 To lstLookFor.ListCount - 1
strLookFor = lstLookFor.Column(0, q)
If strLookFor <> "" Then
blnPresent = False
' перечитываем все формы, сохранённые в базе
For Each objFrm In CurrentProject.AllForms
strObjName = objFrm.Name
Select Case strObjName
' список форм, исключённых из обработки
Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"
Case Else
' открываем форму
DoCmd.OpenForm strObjName, acDesign
' выбираем свойство "источник записей"
Set prp = Forms(strObjName).Properties("RecordSource")
' изсеняем источник данных
If Not IsNull(prp.Value) Then
strSource = prp.Value
If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
blnPresent = True
End If
End If
If Not blnPresent Then
' перечитываем элементы формы
For Each ctl In Forms(strObjName).Controls
' выбираем свойство "тип элемента"
Set prp = ctl.Properties("ControlType")
' если это ComboBox
If prp.Value = 111 Then
' выбираем свойство "источник строк"
Set prp = ctl.Properties("RowSource")
' изсеняем источник данных
If Not IsNull(prp.Value) Then
strSource = prp.Value
If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
blnPresent = True
Exit For
End If
End If
End If
Next ctl
End If
' закрываем форму с сохранением изменений
DoCmd.Close acForm, strObjName, acSaveNo
' выходим из цыкла, если нашла запрос
If blnPresent Then Exit For
End Select
Next objFrm
If Not blnPresent Then
If InStr(1, Me.lstQuery.RowSource, strLookFor, vbTextCompare) = 0 Then
Me.lstQuery.AddItem strLookFor
End If
End If
End If
Next q
' включаем обновление экрана
Application.Echo True, "Получение свойств завершено."
MsgBox "Обработка окончена", , coTitle
Exit Sub
ErrorHandler:
Call ErrMsg(Me.Caption) ' матюгальник
Resume Next
End Sub
Private Sub cmdLookFor_Click()
If vbYes <> MsgBox("Произвести поиск форм и их элементов по имени запроса с которым они связаны?" _
, vbYesNo + vbQuestion, coTitle) _
Then Exit Sub
Dim ctl As Control
Dim objFrm As AccessObject
Dim prp As Property
Dim strObjName As String
Dim strSource As String
Dim strLookFor As String
On Error GoTo ErrorHandler
strLookFor = SpecSimvOchist(Nz(Me.txbLookFor.Value, ""), True)
If strLookFor <> "" Then
' отключаем обновление экрана
Application.Echo False, "Идёт получение свойств. Это может занять значительное время. Подождите..."
' очищаем список запросов перед поиском
Me.lstQuery.RowSource = ""
' перечитываем все формы, сохранённые в базе
For Each objFrm In CurrentProject.AllForms
strObjName = objFrm.Name
Select Case strObjName
' список форм, исключённых из обработки
Case Is = Me.Name, "Заставка", "frmAdmLookForQuery"
Case Else
' открываем форму
DoCmd.OpenForm strObjName, acDesign
' выбираем свойство "источник записей"
Set prp = Forms(strObjName).Properties("RecordSource")
' изсеняем источник данных
If Not IsNull(prp.Value) Then
strSource = prp.Value
If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
Me.lstQuery.AddItem strObjName
End If
End If
' перечитываем элементы формы
For Each ctl In Forms(strObjName).Controls
' выбираем свойство "тип элемента"
Set prp = ctl.Properties("ControlType")
' если это ComboBox
If prp.Value = 111 Then
' выбираем свойство "источник строк"
Set prp = ctl.Properties("RowSource")
' изсеняем источник данных
If Not IsNull(prp.Value) Then
strSource = prp.Value
If InStr(1, strSource, strLookFor, vbTextCompare) > 0 Then
Me.lstQuery.AddItem ctl.Name & " on " & strObjName
End If
End If
End If
Next ctl
' закрываем форму с сохранением изменений
DoCmd.Close acForm, strObjName, acSaveNo
End Select
Next objFrm
' включаем обновление экрана
Application.Echo True, "Получение свойств завершено."
MsgBox "Обработка окончена", , coTitle
Else
MsgBox "Поиск запросов по образцу не возможен, т.к. не указан образец поиска?" _
, vbExclamation, coTitle
End If
Exit Sub
ErrorHandler:
Call ErrMsg(Me.Caption) ' матюгальник
Resume Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
txbLookFor.Value = Null
lstQuery.RowSource = ""
lstLookFor.RowSource = ""
End Sub |
|
- Функция
ErrMsg
| Visual Basic | 1
2
3
4
5
6
7
8
| Public Sub ErrMsg( _
Optional strTitle As String = "Error" _
)
If Err <> 0 Then
MsgBox Err.Source & " --> " & Err.Description, , strTitle
Err.Clear
End If
End Sub |
|
Вернуться к обсуждению: Делимся наработками MS Access
5
|
