Проблема с БД в MS Access

12.07.2013, 08:52. **Показов** 1244. **Ответов** 2

Студворк — интернет-сервис помощи студентам

Всем привет!
В общем такая проблема есть сервер SQL, в ней есть база данных в MS Acess с различными документами, калькуляциями и прочим, при входе в эту базу с сервера и обновлений базы выдается ошибка Type mismatch Номер ошибки: 13
Честно не понимаю в чем проблема, уже так было, я перезагрузил сервер и все прошло, но со временем опять повторилось, после повторной перезагрузки ошибка осталась.
Думаю проблема в коде, а именно в каком не пойму, но больше склоняюсь что именно в начальном.
Вот, собственно, и он:

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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
Option Compare Database
Option Explicit
 
Private Sub exit_Click()
On Error GoTo err
DoCmd.Close acDataAccessPage, "naryad"
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
 
Private Sub Form_Load()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
vers.Caption = version()
cop.Caption = copir()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
cn.Open ConnectServer(BName())
year.Value = seti("year")
month.Value = seti("month")
 
logo.Caption = "Ãëàâíàÿ ñòðàíèöà"
For i = 1 To 8
g = "m" & i
If i = 1 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 1 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
 
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m1_Click()
On Error GoTo err
Dim i As Long
Dim a, b, g As String
logo.Caption = "Ãëàâíàÿ ñòðàíèöà"
 
For i = 1 To 8
g = "m" & i
If i = 1 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 1 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m2_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Íàðÿäû"
 
For i = 1 To 8
g = "m" & i
If i = 2 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 2 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m3_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Êàëüêóëÿöèè"
 
For i = 1 To 8
g = "m" & i
If i = 3 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 3 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m4_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "ÀÊÒû"
 
For i = 1 To 8
g = "m" & i
If i = 4 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 4 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m5_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Ñïðàâî÷íèêè"
 
For i = 1 To 8
g = "m" & i
If i = 5 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 5 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m6_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Îò÷åòû"
 
For i = 1 To 8
g = "m" & i
If i = 6 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 6 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m7_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Íàñòðîéêè"
 
For i = 1 To 8
g = "m" & i
If i = 7 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 7 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
Private Sub m8_Click()
On Error GoTo err
Dim a, b, g As String
Dim i As Long
logo.Caption = "Àðõèâ"
 
For i = 1 To 8
g = "m" & i
If i = 8 Then
Form.Controls(g).ForeColor = 255
Form.Controls(g).FontBold = True
Else
Form.Controls(g).ForeColor = 0
Form.Controls(g).FontBold = False
End If
Next
 
a = "main_"
For i = 1 To 8
b = a & i
If i = 8 Then
Form.Controls(b).Visible = True
Else
Form.Controls(b).Visible = False
End If
Form.Controls(b).Left = 2250
Form.Controls(b).Width = 4950
Form.Controls(b).Height = 3200
Form.Controls(b).TOP = 1450
Next
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub
 
Private Sub upd_Click()
On Error GoTo err
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim a As Integer
Dim b As String
a = seti("year")
b = seti("month")
cn.Open ConnectServer(BName())
 
rs.Open ("SELECT Sum(tek) as sum FROM plobct WHERE obct <>'ÖÐÃÒÎ' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!a1.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(izg) as sum FROM plobct WHERE obct <>'ÖÐÃÒÎ' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aa1.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(tek+izg) as sum FROM plobct WHERE obct <>'ÖÐÃÒÎ' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aaa1.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(kolv1*nv) as sum FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='True' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
rs.Close
rs.Open ("SELECT Sum(kolv1*normve) as sum FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND otl ='False' AND vidrab ='òåê. ðåìîíò' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!a2.Caption = Format(rs!sum, "0.00")
rs.Close
Else
rs1.Open ("SELECT Sum(kolv1*normve) as sum FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND otl ='False' AND vidrab ='òåê. ðåìîíò' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs1!sum) Then
Form!main_1!a2.Caption = Format(rs!sum, "0.00")
Else
Form!main_1!a2.Caption = Format(rs!sum + rs1!sum, "0.00")
End If
rs1.Close
rs.Close
End If
 
rs.Open ("SELECT Sum(kolv1*nv) as sum FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='False' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aa2.Caption = Format(rs!sum, "0.00")
rs.Close
 
Form!main_1!aaa2.Caption = Abs(Form!main_1!a2.Caption) + Abs(Form!main_1!aa2.Caption)
If IsNull(Form!main_1!a2.Caption) Then Form!main_1!aaa2.Caption = Form!main_1!aa2.Caption
If IsNull(Form!main_1!aa2.Caption) Then Form!main_1!aaa2.Caption = Form!main_1!a2.Caption
 
If IsNull(Form!main_1!a2.Caption) Or Form!main_1!a2.Caption = "" Or IsNull(Form!main_1!a1.Caption) Or Form!main_1!a1.Caption = "" Then
Form!main_1!a3.Caption = ""
Else
Form!main_1!a3.Caption = Format(Abs(Form!main_1!a2.Caption) / Abs(Form!main_1!a1.Caption), "0.00%")
End If
 
If IsNull(Form!main_1!aa2.Caption) Or Form!main_1!aa2.Caption = "" Or IsNull(Form!main_1!aa1.Caption) Or Form!main_1!aa1.Caption = "" Then
Form!main_1!aa3.Caption = ""
Else
Form!main_1!aa3.Caption = Format(Abs(Form!main_1!aa2.Caption) / Abs(Form!main_1!aa1.Caption), "0.00%")
End If
 
If IsNull(Form!main_1!aaa2.Caption) Or Form!main_1!aaa2.Caption = "" Or IsNull(Form!main_1!aaa1.Caption) Or Form!main_1!aaa1.Caption = "" Then
Form!main_1!aaa3.Caption = ""
Else
Form!main_1!aaa3.Caption = Format(Abs(Form!main_1!aaa2.Caption) / Abs(Form!main_1!aaa1.Caption), "0.00%")
End If
 
rs.Open ("SELECT Sum(sumt) as sum FROM plobct WHERE year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!a4.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(sumi) as sum FROM plobct WHERE obct <>'ÖÐÃÒÎ' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aa4.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(sumt+sumi) as sum FROM plobct WHERE obct <>'ÖÐÃÒÎ' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aaa4.Caption = Format(rs!sum, "0.00")
rs.Close
 
Dim g, d, z, n As String
Dim i As Long
g = Replace(seti_d("chch"), ",", ".")
g = seti_d("chch")
n = 0
rs.Open ("SELECT * FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND vidrab ='òåê. ðåìîíò' AND otl ='False' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
For i = 1 To rs.RecordCount
d = Format((rs!normve * Abs(g)), "0.00")
If d = "" Or IsNull(d) Then z = 0
If d <> "" Then z = d * rs!kolv1
n = Abs(n) + z
rs.GetRows (1)
Next
 
If IsNull(n) Or n = 0 Or n = "" Then
Form!main_1!a5.Caption = Null
Else
Form!main_1!a5.Caption = Format(n, "0.00")
End If
rs.Close
 
rs.Open ("SELECT Sum(kolv1*stoim) as sum FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='False' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aa5.Caption = Format(rs!sum, "0.00")
rs.Close
 
If Form!main_1!a5.Caption = "" Then Form!main_1!aaa5.Caption = Form!main_1!aa5.Caption
If Form!main_1!aa5.Caption = "" Then Form!main_1!aaa5.Caption = Form!main_1!a5.Caption
If Form!main_1!aa5.Caption <> "" And Form!main_1!a5.Caption <> "" Then Form!main_1!aaa5.Caption = Abs(Form!main_1!a5.Caption) + Abs(Form!main_1!aa5.Caption)
 
 
If Form!main_1!a5.Caption = "" Then Form!main_1!a6.Caption = Form!main_1!a4.Caption
If Form!main_1!a4.Caption = "" Then Form!main_1!a6.Caption = Form!main_1!a5.Caption
If Form!main_1!a4.Caption <> "" And Form!main_1!a5.Caption <> "" Then Form!main_1!a6.Caption = Abs(Form!main_1!a5.Caption) - (Form!main_1!a4.Caption)
 
If Form!main_1!aa5.Caption = "" Then Form!main_1!aa6.Caption = Form!main_1!aa4.Caption
If Form!main_1!aa4.Caption = "" Then Form!main_1!aa6.Caption = Form!main_1!aa5.Caption
If Form!main_1!aa4.Caption <> "" And Form!main_1!aa5.Caption <> "" Then Form!main_1!aa6.Caption = Abs(Form!main_1!aa5.Caption) - Abs(Form!main_1!aa4.Caption)
 
If Form!main_1!aaa5.Caption = "" Then Form!main_1!aaa6.Caption = Form!main_1!aaa4.Caption
If Form!main_1!aaa4.Caption = "" Then Form!main_1!aaa6.Caption = Form!main_1!aaa5.Caption
If Form!main_1!aaa4.Caption <> "" And Form!main_1!aaa5.Caption <> "" Then Form!main_1!aaa6.Caption = Abs(Form!main_1!aaa5.Caption) - Abs(Form!main_1!aaa4.Caption)
 
rs.Open ("SELECT Sum(kolv1*cm) as sum FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='False' AND year =" & a & " AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_1!aa7.Caption = Format(rs!sum, "0.00")
rs.Close
 
'===================================== 2
rs.Open ("SELECT * FROM naryad WHERE otl ='False' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_2!it5.Caption = rs.RecordCount
rs.Close
 
rs.Open ("SELECT Sum(naryad.censum) AS sum FROM naryad WHERE otl ='False' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_2!it6.Caption = Format(rs!sum, "0.00")
End If
rs.Close
 
rs.Open ("SELECT Sum(naryad.normvi) AS sum FROM naryad WHERE otl ='False' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_2!it7.Caption = Format(rs!sum, "0.00")
End If
rs.Close
 
rs.Open ("SELECT * FROM naryad WHERE otl ='False' AND year ='" & a & "' AND month ='" & b & "' AND stat ='True'"), cn, adOpenKeyset, adLockPessimistic
Form!main_2!it8.Caption = rs.RecordCount
rs.Close
 
rs.Open ("SELECT * FROM naryad WHERE otl ='False' AND year ='" & a & "' AND month ='" & b & "' AND stat ='False'"), cn, adOpenKeyset, adLockPessimistic
Form!main_2!it9.Caption = rs.RecordCount
rs.Close
 
rs.Open ("SELECT * FROM naryad WHERE otl ='True' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_2!it10.Caption = rs.RecordCount
rs.Close
 
rs.Open ("SELECT Sum(naryad.censum) AS sum FROM naryad WHERE otl ='True' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_2!it11.Caption = Format(rs!sum, "0.00")
End If
rs.Close
 
rs.Open ("SELECT Sum(naryad.normvi) AS sum FROM naryad WHERE otl ='True' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_2!it12.Caption = Format(rs!sum, "0.00")
End If
rs.Close
 
'======================================= 3
 
rs.Open ("SELECT count(id) As cou FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND year ='" & a & "' AND month ='" & b & "'"), cn, adOpenKeyset, adLockPessimistic
Form!main_3!obr1.Caption = rs!cou
rs.Close
 
rs.Open ("SELECT count(idkalk) As cou FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND stat ='True' AND otl ='False' AND year ='" & a & "' AND month ='" & b & "' AND vidrab <>'òåê. ðåìîíò'"), cn, adOpenKeyset, adLockPessimistic
Form!main_3!obr2.Caption = rs!cou
rs.Close
 
rs.Open ("SELECT * FROM naryad WHERE idkalk IS null AND obct <>'ÖÐÃÒÎ' AND stat ='True' AND otl ='False' AND year ='" & a & "' AND month ='" & b & "' AND vidrab <>'òåê. ðåìîíò'"), cn, adOpenKeyset, adLockPessimistic
Form!main_3!obr3.Caption = rs.RecordCount
rs.Close
 
'====================================== 4
 
rs.Open ("SELECT Count(id) As cou FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='False' AND kolv1 =0 AND otl_kolv <>0"), cn, adOpenKeyset, adLockPessimistic
Form!main_4!i1.Caption = rs!cou
rs.Close
 
rs.Open ("SELECT Count(id) As cou FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND vidrab ='òåê. ðåìîíò' AND kolv1 =0 AND otl_kolv <>0"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!cou) Then
Else
Form!main_4!i1.Caption = Abs(Form!main_4!i1.Caption) + rs!cou
End If
rs.Close
 
rs.Open ("SELECT Sum(otl_kolv) As sum FROM kalk WHERE obct <>'ÖÐÃÒÎ' AND tekr_st ='False'"), cn, adOpenKeyset, adLockPessimistic
Form!main_4!i2.Caption = rs!sum
rs.Close
 
rs.Open ("SELECT Sum(otl_kolv) AS sum FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND vidrab ='òåê. ðåìîíò'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_4!i2.Caption = Abs(Form!main_4!i2.Caption) + rs!sum
End If
rs.Close
 
rs.Open ("SELECT Sum(nv*otl_kolv) As sum FROM kalk WHERE obct <>'ÖÐÃÒÎ'"), cn, adOpenKeyset, adLockPessimistic
Form!main_4!i3.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(normve*otl_kolv) AS sum FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND vidrab ='òåê. ðåìîíò'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_4!i3.Caption = Format(Abs(Form!main_4!i3.Caption) + rs!sum, "0.00")
End If
rs.Close
 
rs.Open ("SELECT Sum(stoim*otl_kolv) As sum FROM kalk"), cn, adOpenKeyset, adLockPessimistic
Form!main_4!i4.Caption = Format(rs!sum, "0.00")
rs.Close
 
rs.Open ("SELECT Sum(cened*otl_kolv) AS sum FROM naryad WHERE obct <>'ÖÐÃÒÎ' AND vidrab ='òåê. ðåìîíò'"), cn, adOpenKeyset, adLockPessimistic
If IsNull(rs!sum) Then
Else
Form!main_4!i4.Caption = Format(Abs(Form!main_4!i4.Caption) + rs!sum, "0.00")
End If
rs.Close
 
MsgBox "Îáíîâëåíî...", vbInformation, ""
 
Exit Sub
err:
Call errorb(err.Description, err.HelpContext, err.HelpFile, err.Number, err.Source, err.LastDllError)
End Sub

Помогите чем сможете, буду очень благодарен! :-)

Добавлено через 2 минуты
Или может если нужно могу полностью всю программу выслать:-)

mobile · 12.07.2013, 12:24

Слишком мало информации. При обилии слабоструктурированного кода, трудно выделить глазами конфликтный участок.

Gunsik, когда возникнет сообщение об ошибке, нажмите CTRL+BREAK. Сообщение должно смениться не другое с кнопкой Debug. Нажмите на эту кнопку и программа выйдет на ошибочную команду. Вот ее и покажите.
После нахождения ошибочного места, желательно поставить брэкпойнт (F9 в редакторе ВБА) за несколько операторов до команды с ошибкой и отлаживать пошагово, смотря на значения переменных, соответствуют ли они ожидаемым

@уни · 12.07.2013, 13:44

Могу порекомендовать свой модуль для ведения журнала сообщений об ошибках Logger.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
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CLogger"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
 
 
Private FLogMode As Long
Private FLogFileName As String
 
 
Property Get FileName() As String
 
    FileName = FLogFileName
    
End Property
 
 
Public Sub StartLogging(FileName As String, LogMode As Long)
    '<EhHeader>
    On Error Resume Next
    '</EhHeader>
    
    FLogFileName = FileName
 
    If LogMode = VBRUN.LogModeConstants.vbLogToFile Then
        
        ' Проверяем доступ к лог-файлу
        Dim FSO As FileSystemObject
        Dim TS As TextStream
           
        Set FSO = New FileSystemObject
        Set TS = FSO.OpenTextFile(FileName, ForAppending, True)
        
        If Not TS Is Nothing Then
    
            TS.Close
            
            FLogMode = LogMode
    
        End If
        
        Set TS = Nothing
        Set FSO = Nothing
    
    End If
 
End Sub
 
 
Public Sub Info(Text As String)
 
    Select Case FLogMode
    
        Case VBRUN.LogModeConstants.vbLogOff:
    
            Debug.Print CStr(Date) & " " & CStr(Time) & " [INFO ] " & Text
            
            
        Case VBRUN.LogModeConstants.vbLogToFile:
        
            Dim FSO As Scripting.FileSystemObject
            Dim TS As TextStream
               
            Set FSO = New Scripting.FileSystemObject
            Set TS = FSO.OpenTextFile(FLogFileName, ForAppending, True)
            
            TS.WriteLine CStr(Date) & " " & CStr(Time) & " [INFO ] " & Text
            
            TS.Close
            
            Set TS = Nothing
            Set FSO = Nothing
    
    
    End Select
    
End Sub
 
 
Public Sub Warn(Text As String)
 
    Select Case FLogMode
    
        Case VBRUN.LogModeConstants.vbLogOff:
    
            Debug.Print CStr(Date) & " " & CStr(Time) & " [WARN ] " & Text
            
            
        Case VBRUN.LogModeConstants.vbLogToFile:
            
            Dim FSO As Scripting.FileSystemObject
            Dim TS As TextStream
               
            Set FSO = New Scripting.FileSystemObject
            Set TS = FSO.OpenTextFile(FileName, ForAppending, True)
            
            TS.WriteLine CStr(Date) & " " & CStr(Time) & " [WARN ] " & Text
            
            TS.Close
            
            Set TS = Nothing
            Set FSO = Nothing
    
    
    End Select
    
End Sub
 
 
Public Sub Error(Text As String)
 
    Select Case FLogMode
    
        Case VBRUN.LogModeConstants.vbLogOff:
    
            Debug.Print CStr(Date) & " " & CStr(Time) & " [ERROR] " & Text
            
            
        Case VBRUN.LogModeConstants.vbLogToFile:
         
            Dim FSO As Scripting.FileSystemObject
            Dim TS As TextStream
               
            Set FSO = New Scripting.FileSystemObject
            Set TS = FSO.OpenTextFile(FileName, ForAppending, True)
            
            TS.WriteLine CStr(Date) & " " & CStr(Time) & " [ERROR] " & Text
            
            TS.Close
            
            Set TS = Nothing
            Set FSO = Nothing
    
    
    End Select
    
End Sub
 
Private Sub Class_Initialize()
    
    FLogMode = VBRUN.LogModeConstants.vbLogOff
 
End Sub

Использую его вот так:

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
'**
'@rem Журнал проекта
Public Logger As CLogger
 
'**
'@rem Точка входа в программу
Private Sub Main()
 
    On Error Resume Next
    
    ' Создаём экземпляр объекта настроек (инициализация по умолчанию)
    Set Settings = New CSettings
        
    ' Загружаем сохранённые настройки
    Settings.LoadSettings
    
    ' Перезаписываем лог файл, если флаг установлен
    If Settings.RewriteLogFile Then
    
        DeleteFile Settings.LogFilePath
        
    End If
 
    ' Создаём экземпляр журнала
    Set Logger = New CLogger
    
    ' Запускаем ведение журнала
    Logger.StartLogging Settings.LogFilePath, VBRUN.LogModeConstants.vbLogToFile
        
    ' Проверяем наличие файла с базой данных запросов
    Dim FSO As FileSystemObject
    
    ' Создаём экземпляр объекта
    Set FSO = New FileSystemObject
    
    If Not (FSO.FileExists(App.Path & "\" & REQUEST_DB_FILE_NAME)) Then
        
        Logger.Info "[updserv.ModuleMain.Main]: Не найден файл базы запросов: " & REQUEST_DB_FILE_NAME
    
        Logger.Info "[updserv.ModuleMain.Main]: Копирование: " & REQUEST_EMPTY_DB_FILE_NAME & _
            " в " & REQUEST_DB_FILE_NAME
    
        FSO.CopyFile App.Path & "\" & REQUEST_EMPTY_DB_FILE_NAME, _
            App.Path & "\" & REQUEST_DB_FILE_NAME, False
    
    End If
    
    Set FSO = Nothing
    
    ' Инициализация компонентов для правильной работы интерфейса
    InitCommonControls
   
    ' Прячем основное окно приложения
    FormMain.Hide
           
End Sub

С кодом ошибок использую так:

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
'**
'@param        ErrNum Required. Long.
'@param        ErrDescription Required. String.
'@return       String.
'@rem <h2>GetErrorMessageById</h2>
'Функция возвращает описание исключительной ситуации по номеру ошибки.
Public Function GetErrorMessageById(ErrNum As Long, ErrDescription As String) As String
    
    Dim ТекстОшибки As String
    
    ТекстОшибки = "(" & CStr(ErrNum) & ") "
 
    Select Case ErrNum
        
            'Определённые пользователем ошибки
        Case ОШИБКА_НЕИЗВЕСТНАЯ:
 
            ТекстОшибки = ТекстОшибки & "Неизвестная ошибка"
        
            'Системные ошибки
        Case Else
 
            ТекстОшибки = ТекстОшибки & ErrDescription
            
    End Select
 
    GetErrorMessageById = ТекстОшибки
 
End Function
 
Private Sub RefreshBody()
    '<EhHeader>
    On Error GoTo RefreshBody_Err
    '</EhHeader>
    
    ShapeDescription.Top = CommandOK.Top - ShapeDescription.Height - 120
    ShapeDescription.Left = 20
    ShapeDescription.Width = ScaleWidth - 40
    
    FrameSplitterUpDown.Height = Settings.SplittersThickness
    FrameSplitterUpDown.Top = ShapeDescription.Top - FrameSplitterUpDown.Height - 40
    FrameSplitterUpDown.Left = ShapeDescription.Left
    FrameSplitterUpDown.Width = ShapeDescription.Width
    
    ShapeMain.Top = 20
    ShapeMain.Left = 20
    ShapeMain.Width = ScaleWidth - 40
    ShapeMain.Height = FrameSplitterUpDown.Top - ShapeMain.Top - 40
    
    MSFGItems.Top = ShapeMain.Top + 40
    MSFGItems.Left = ShapeMain.Left + 40
    MSFGItems.Width = ShapeMain.Width - 80
    MSFGItems.Height = ShapeMain.Height - 80
    
    LabelDescription.Top = ShapeDescription.Top
    LabelDescription.Left = ShapeDescription.Left
    LabelDescription.Width = ShapeDescription.Width
    LabelDescription.Height = ShapeDescription.Height
    
    ' Если строки не умещаются во фрейме, то появляется вертикальная полоска прокрутки
    ' Корректируем ширину столбцов для этого случая
    Dim ScrollWidth As Long
 
    ScrollWidth = Screen.TwipsPerPixelX * GetSystemMetrics(SM_CXVSCROLL)
 
    With MSFGItems
    
        If .rows * .RowHeight(0) > .Height Then
    
            If .Width > (.ColWidth(0) + ScrollWidth) Then
    
                .ColWidth(3) = .Width - .ColWidth(0) - .ColWidth(1) - .ColWidth(2) - ScrollWidth
    
            End If
    
        Else
    
            If .Width > .ColWidth(0) Then
    
                .ColWidth(3) = .Width - .ColWidth(0) - .ColWidth(1) - .ColWidth(2)
    
            End If
    
        End If
    
    End With
    
    '<EhFooter>
    Exit Sub
 
RefreshBody_Err:
    Logger.Info "[updserv.FormReport.RefreshBody]: " & GetErrorMessageById( _
            Err.Number, Err.Description)
 
    Resume Next
 
    '</EhFooter>
End Sub

Результат в логе такой:

Code
1
2
3
4
5
05.07.2013 18:25:51 [INFO ] [updserv.FormReport.RefreshBody]: (380) Invalid property value
05.07.2013 18:25:51 [INFO ] [updserv.FormReport.RefreshBody]: (380) Invalid property value
05.07.2013 18:25:51 [INFO ] [updserv.FormReport.RefreshBody]: (380) Invalid property value
05.07.2013 18:25:51 [INFO ] [updserv.FormReport.RefreshBody]: (380) Invalid property value
05.07.2013 18:25:51 [INFO ] [updserv.FormReport.RefreshBody]: (380) Invalid property value

Оформление обработчика ошибок у меня выполняется по шаблону средой автоматически. Я использую CodeSMART для этого. Названия модуля и всё прочее он вставляет сам. Таким образом гораздо проще локализовывать ошибки.

Новые блоги и статьи Все статьи Все блоги /
Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ	Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .	Использование значений реквизитов справочника в документе, с определенными условиями и правами Maks 07.04.2026 1. Контроль срока действия договора Алгоритм из решения ниже реализован на примере нетипового документа "ЗаявкаНаРаботу", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если. . .
Доступность команды формы по условию Maks 07.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: сделать доступной кнопку (команда формы "ЗавершитьСписание") при. . .	Уведомление о неверно выбранном значении справочника Maks 06.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "НарядПутевка", разработанного в конфигурации КА2. Задача: уведомлять пользователя, если в документе выбран неверный склад. . .	Установка Qt Creator для C и C++: ставим среду, CMake и MinGW без фреймворка Qt 8Observer8 05.04.2026 Среду разработки Qt Creator можно установить без фреймворка Qt. Есть отдельный репозиторий для этой среды: https:/ / github. com/ qt-creator/ qt-creator, где можно скачать установщик, на вкладке Releases:. . .	AkelPad-скрипты, структуры, и немного лирики.. testuser2 05.04.2026 Такая программа, как AkelPad существует уже давно, и также давно существуют скрипты под нее. Тем не менее, прога живет, периодически что-то не спеша дополняется, улучшается. Что меня в первую очередь. . .

mobile 26827 / 14507 / 3192 Регистрация: 28.04.2012 Сообщений: 15,782
	12.07.2013, 12:24
	Слишком мало информации. При обилии слабоструктурированного кода, трудно выделить глазами конфликтный участок. Gunsik, когда возникнет сообщение об ошибке, нажмите CTRL+BREAK. Сообщение должно смениться не другое с кнопкой Debug. Нажмите на эту кнопку и программа выйдет на ошибочную команду. Вот ее и покажите. После нахождения ошибочного места, желательно поставить брэкпойнт (F9 в редакторе ВБА) за несколько операторов до команды с ошибкой и отлаживать пошагово, смотря на значения переменных, соответствуют ли они ожидаемым 1

Проблема с БД в MS Access

Решение