База разделена на интерфейсную и серверную части, с рабочего места запускаю процедуру , которая изменяет данные в шести таблицах. 1800 строк в главной таблице. Перебирая эти строки соответственно данные и меняются. Но так как работаю в сети всё это происходит очень долго порядка 30-40 минут. Может кто подскажет, как бы скорости прибавить. Или как память под эту процедуру выделить...?

Ну если есть время почитать - пожалуйста:


Dim pro As ADODB.Recordset
Dim docs As ADODB.Recordset
Dim syst As ADODB.Recordset
Dim dog As ADODB.Recordset
Dim doc As ADODB.Recordset
Dim dogs1 As ADODB.Recordset
Dim dogs As ADODB.Recordset
Dim X As Integer
Dim y As Fields
Dim rst As ADODB.Recordset
Dim stDocName1, stDocName As String
Dim ccc As String
Dim systema, proc, k, k1 As Integer
Dim Firma As ADODB.Recordset
Set Firma = New ADODB.Recordset
Firma.ActiveConnection = CurrentProject.Connection
Firma.Open "select * from фирма where [код]=1", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'""""""
Dim ssu11 As Currency
Dim pr1 As Field
Dim kss, kss1
Dim g
Dim ssu, ssu1, skidka As Currency
Dim pr As Field
Dim ff, tz As Integer
Dim dat1 As Date
Dim msN, msK As Date

Dim ks As Field
Dim ks1 As Integer
Dim aaa, sss1, strsQl As String

'"""""
Dim zs
Dim cen As Integer
Dim ctl As Control
Dim a11 As String
k = 6787
k1 = 449
cen = 0
'zs = InputBox("Введите предмет оплаты")
rt
zs = "за " & sss & " " & 2004 & " г."
Dim x5 As Integer
If sss = "январь" Then x5 = 1
If sss = "февраль" Then x5 = 2
If sss = "март" Then x5 = 3
If sss = "апрель" Then x5 = 4
If sss = "май" Then x5 = 5
If sss = "июнь" Then x5 = 6
If sss = "июль" Then x5 = 7
If sss = "август" Then x5 = 8
If sss = "сентябрь" Then x5 = 9
If sss = "октябрь" Then x5 = 10
If sss = "ноябрь" Then x5 = 11
If sss = "декабрь" Then x5 = 12

msN = DateSerial(2004, x5, 1)
'msN = (Format(msN, "mm\/dd\/yyyy"))
msK = (DateSerial(2004, x5 + 1, Day(2))) - 1
msK = (Format(msK, "mm\/dd\/yyyy"))
Set rst = New ADODB.Recordset
rst.ActiveConnection = CurrentProject.Connection
rst.Open "select * from Продажа where [код клиента]>=" & Forms![Главная1]![Код клиента], CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'rst.Open "Продажа", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rst.MoveLast

rst.MoveFirst
Do Until rst.EOF
If rst("отказ") = True Then GoTo aaa3
If rst("фпк") = True Then GoTo aaa3
'MsgBox ("Код клиента ") & (rst("Код клиента"))
If IsNull(DSum("[договор]", "[договор]", "[Код Клиента] = " & (rst("Код Клиента")))) Then GoTo aaa1

Set dog = New ADODB.Recordset
dog.Open "select * from договор where [Код клиента] =" & (rst("Код клиента")), CurrentProject.Connection, adOpenDynamic, adLockOptimistic
' MsgBox ("Сумма = " & DSum("[SS_MAIN]", "[договор запрос]", "[Код Клиента] = " & (dog("Код Клиента") & " and [обслуживание]=" & True)))
If IsNull(DSum("[SS_MAIN]", "[договор запрос]", "[Код Клиента] = " & (dog("Код Клиента") & " and [обслуживание]=" & True))) Then
cen = 0
GoTo z11
End If

cen = DSum("[SS_MAIN]", "[договор запрос]", "[Код Клиента] = " & (dog("Код Клиента") & " and [обслуживание]=" & True))
z11:
Do Until dog.EOF
'№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№

Set dogs1 = New ADODB.Recordset
dogs1.Open "select * from [договор запрос] where [Номер договора] =" & (dog("договор") & " and [обслуживание]=" & True), CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If (DSum("[обслуживание]", "[договор запрос]", "[Код Клиента] = " & (dog("Код Клиента")))) = 0 Then
dog.Close
Set dog = Nothing
dogs1.Close
Set dogs1 = Nothing
GoTo aaa1
End If
dogs1.Close
Set dogs1 = Nothing
'№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№№

Set dogs = New ADODB.Recordset
dogs.Open "select * from [договор запрос] where [Номер договора] =" & (dog("договор") & " and [обслуживание]=" & True), CurrentProject.Connection, adOpenDynamic, adLockOptimistic
Do Until dogs.EOF
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Set syst = New ADODB.Recordset ' Возвращает ссылку на текущую базу данных.
syst.Open "ценасист", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
Do Until syst.EOF
' If syst("код Системы") = [ДоговорДанные].Form![ДоговорС].Form![Код системы] And syst("Дата") >= #1/9/2002# Then
If syst("код Системы") = dogs("Код системы") And syst("Дата") = msN Then
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Set doc = New ADODB.Recordset ' Возвращает ссылку на текущую базу данных.
doc.Open "документы", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
doc.MoveLast
If doc![№ счет-фактуры] = "0" And doc![Код клиента] = rst("Код клиента") And doc![За что] Like ("*" & sss & "*2004*") Then GoTo z1
kss = doc![Кдок] + 1
'MsgBox ("KSS = " & kss)
With doc
.AddNew ' Добавляет новую запись.
![Кдок] = kss
![№ счет-фактуры] = "0" ' Заполнение данными.
![За что] = zs
![Код клиента] = rst("Код клиента")
![Дата] = msK
.Update ' Сохранение изменений.

End With
GoTo z1
z1:
Forms!Главная1![Документы1].Form.Requery

Dim sk As Integer
Dim NDS As Currency
Set docs = New ADODB.Recordset ' Возвращает ссылку на текущую базу данных.
docs.Open "документысист", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'MsgBox (Forms![Главная1]![Документы1].Form![Документы1].Form![Поле42])
With docs
'MsgBox ("1")
.AddNew ' Добавляет новую запись.
![Кдок] = doc("Кдок")
'doc.Close
'Set doc = Nothing
![Системы] = dogs("системы")
If dogs("скидка") < 100 Then
'sk = syst("Сопровождение") - syst("Сопровождение") * (100 - dogs("скидка") / 100)
If cen = 0 Then
![Без НДС] = Round(FormatNumber(syst("Сопровождение") - syst("Сопровождение") * ((100 - dogs("скидка")) / 100), 2), 2)
ElseIf cen > 0 Then
![Без НДС] = Round(FormatNumber(syst("С учетом осн Системы") - syst("С учетом осн Системы") * ((100 - dogs("скидка")) / 100), 2), 2)
End If
End If
If dogs("скидка") = 100 Then
'sk = syst("Сопровождение") - syst("Сопровождение") * (100 - dogs("скидка") / 100)
If cen = 0 Then
'MsgBox ("!")
![Без НДС] = syst("Сопровождение")
ElseIf cen > 0 Then
![Без НДС] = syst("С учетом осн Системы")
End If
End If
If dogs("скидка") > 100 Then
'sk = syst("Сопровождение") - syst("Сопровождение") * (100 - dogs("скидка") / 100)
If cen = 0 Then
![Без НДС] = Round(FormatNumber((syst("Сопровождение") + syst("Сопровождение") * ((dogs("скидка") - 100) / 100)), 2), 2)
ElseIf cen > 0 Then
![Без НДС] = Round(FormatNumber((syst("С учетом осн Системы") + syst("С учетом осн Системы") * ((dogs("скидка") - 100) / 100)), 2), 2)
End If
End If

'![Без НДС] = syst("Сопровождение")
Refresh
ssu1 = ((docs![Без НДС]) * (1 + (Firma![Процент НДС] / 100)))
ssu1 = Round(FormatNumber(ssu1, 2), 2)
![СуммаС] = ssu1
'![Дата] = #10/1/2002#

ssu1 = 0
NDS = (docs![Без НДС] * (Firma![Процент НДС] / 100))
NDS = Round(FormatNumber(NDS, 2), 2)
![Ндс] = NDS
NDS = 0

.Update ' Сохранение изменений.

Refresh
End With
docs.Close
Set docs = Nothing
Refresh

g = Round(FormatNumber(DSum("[СуммаС]", "ДокументыСист", "[Кдок] = " & [Документы1].Form![Документы1].Form![Кдок]), 2), 2)
doc("Сумма") = g

'End If
GoTo z3
syst.Close
Set syst = Nothing
End If

syst.MoveNext
Loop
syst.Close
Set syst = Nothing
z3:
'MsgBox ("ПРивет")
dogs.MoveNext
Loop
dogs.Close
Set dogs = Nothing
dog.MoveNext
Loop
dog.Close
Set dog = Nothing
aaa2:
Dim pro1
Set pro = New ADODB.Recordset ' Возвращает ссылку на текущую базу данных.
pro.Open "платежи", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
pro.MoveLast
'kss = doc![Кдок] + 1
'MsgBox ("KSS = " & kss)
With pro
.AddNew ' Добавляет новую запись.
![Кдок] = kss
'![№ счет-фактуры] = "0" ' Заполнение данными.
![ЗА КАКОЙ ПЕРИОД] = zs
'![Дата] = (DateSerial(Year(Date), Month(Date) + 1, Day(2))) - 1
![Дата] = msK
![Код клиента] = rst("Код клиента")
![Всего] = g
![Осталось] = g
.Update ' Сохранение изменений.
End With
pro.Close
Set pro = Nothing

doc.Update
'g = 0
doc.Close
Set doc = Nothing
'////////////////////////////
aaa1:
[Forms]![Главная1].Form!Клиент.SetFocus
DoCmd.GoToRecord acActiveDataObject, , acNext
'k = k + 1

'k1 = k1 + 1
aaa3:
'MsgBox ("!")
rst.MoveNext
Loop
' Переходит к последней записи.
rst.MoveLast
Set rst = Nothing

Не ругайся - понял сечас всё сделаю