Я понимаю что это некоторых покажеться веселым, но столько Database и Recordset - наверное я по другому не могу.
Ситуация такая, в поле формы заноситься код детали (это база по автозапчастям). После Ентер происходит обработка события. В таблицу заносятся все возможные варианты по этому коду (сам код, замены, дубликаты (неоригинальных запчастей) и т.д. + цены названия и многое другое). Это в двух словах о задаче.
Код ниже:
Поле куда вводим код детали называется Code
База имеет достаточно много таблиц - это необходимость!
Ошибка возникает ближе к концу кода (там пустые строки)
Private Sub Code_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then 'Если ввели Enter
'Описываем переменные
Dim DB, DB2, DB3, DB4 As Database
Dim RS, RS2, RS3, RS4, RS5, RS6, RS7, RS8 As Recordset
Dim A, B As Integer
Dim C As Long
'Определяем настройки клиента
Set DB = OpenDatabase("Setup/Setup.mdb") 'База Setup
Set RS = DB.OpenRecordset("Select * From Setup;")
Set RS2 = DB.OpenRecordset("Select * From DM;")
'Настройка полей
MSFlexGrid1.Rows = 1
If RS![In] = 0 Then
MSFlexGrid1.Cols = 7
MSFlexGrid1.FormatString = "< |<Каталог|<Код детали|<Наименование детали|^Цена|^Доставка|^Срок поставки|<Поставка"
MSFlexGrid1.ColWidth(3) = 4010
MSFlexGrid1.ColWidth(4) = 900
MSFlexGrid1.ColWidth(5) = 900
MSFlexGrid1.ColWidth(6) = 1300
MSFlexGrid1.ColWidth(7) = 1100
Else
MSFlexGrid1.Cols = 8
MSFlexGrid1.FormatString = "< |<Каталог|<Код детали|<Наименование детали|^Цена|^ |^Доставка|^Срок поставки|<Поставка"
MSFlexGrid1.ColWidth(3) = 3100
MSFlexGrid1.ColWidth(4) = 900
MSFlexGrid1.ColWidth(5) = 900
MSFlexGrid1.ColWidth(6) = 900
MSFlexGrid1.ColWidth(7) = 1300
MSFlexGrid1.ColWidth(8) = 1100
End If
MSFlexGrid1.ColWidth(0) = 400
MSFlexGrid1.ColWidth(1) = 1000
MSFlexGrid1.ColWidth(2) = 1500
MSFlexGrid1.BackColorSel = &H80000013
MSFlexGrid1.ForeColorSel = &H0
MSFlexGrid1.BackColorBkg = &H80000009
'Заполняем таблицу с результатом поиска
Set DB2 = OpenDatabase("Setup/Search.mdb") 'База Search
Set RS3 = DB2.OpenRecordset("Select * From Search;")
If RS3.RecordCount > 0 Then
Do Until RS3.EOF 'Очистить таблицу со старым поиском
RS3.Delete
RS3.MoveNext
Loop
End If
'Добавляем записи номинала в таблицу
Set DB3 = OpenDatabase("Prices/" & N() & ".mdb") 'База по Make
Set RS4 = DB3.OpenRecordset("Select * From " & N() & ";")
Do Until RS4.EOF
Set RS5 = DB3.OpenRecordset("Select * From " & RS4![ML] & " Where Code = '" & Code & "';")
If RS5.RecordCount > 0 Then
RS3.AddNew
If RS3.RecordCount = 0 Then 'Заполняем только 1 строку
Set DB4 = OpenDatabase("Prices/Prices.mdb") 'База Prices
Set RS6 = DB4.OpenRecordset("Select * From Prices Where Make = '" & N() & "';")
RS3![0] = RS6!Code
RS3![1] = N()
RS3![2] = RS5![Code]
RS3![3] = RS5![Description]
End If
If RS![In] = 0 Then
RS3![4] = Coma(RS5![Price], 2)
RS2.FindFirst "ID = " & RS4!ID & ""
If RS![PD] = -1 Then RS3![4] = Coma(RS3![4] * (100 - RS2!D) / 100, 2)
If RS![OM] = -1 Then
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS!M) / 100, 2)
Else
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS2!M) / 100, 2)
End If
RS3![5] = RS4![PriceL]
RS3![6] = RS4![TimeL]
RS3![7] = RS4![ML]
Else
RS3![4] = Coma(RS5![Price], 2)
RS2.FindFirst "ID = " & RS4!ID & ""
If RS![PD] = -1 Then RS3![4] = Coma(RS3![4] * (100 - RS2!D) / 100, 2)
If RS![OM] = -1 Then
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS!M) / 100, 2)
Else
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS2!M) / 100, 2)
End If
RS3![5] = Coma(RS5![Price] * (100 - RS2!D) / 100, 2)
RS3![6] = RS4![PriceL]
RS3![7] = RS4![TimeL]
RS3![8] = RS4![ML]
End If
RS3.Update
End If
RS4.MoveNext
Loop
'Добавляем записи замен в таблицу
Set RS7 = DB2.OpenRecordset("Select * From Subs;")
Do Until RS7.EOF 'Очистим таблицу замен
RS7.Delete
RS7.MoveNext
Loop
RS4.MoveFirst 'Заполняем таблицу всех замен
Do Until RS4.EOF
Set RS5 = DB3.OpenRecordset("Select * From " & RS4![ML] & " Where Code = '" & Code & "';")
If RS5.RecordCount > 0 Then
If RS5!Subs > 0 Then
C = RS5!Subs 'Определяем ключ замены
Set RS8 = DB3.OpenRecordset("Select * From " & RS4![ML] & " Where Subs = " & C & " And Code <> '" & Code & "';")
If RS8.RecordCount > 0 Then 'Есть замены
Do Until RS8.EOF
RS7.FindFirst "Subs = '" & RS8!Code & "'"
If RS7.NoMatch Then
RS7.AddNew
RS7![Subs] = RS8!Code
RS7.Update
End If
RS8.MoveNext
Loop
End If
End If
End If
RS4.MoveNext
Loop
Set RS7 = DB2.OpenRecordset("Select Subs From Subs Order by Subs;") 'Сортируем замены по возрастанию
If RS7.RecordCount > 0 Then RS7.MoveFirst
Do Until RS7.EOF
RS3.MoveLast
A = RS3.AbsolutePosition
RS4.MoveFirst
Do Until RS4.EOF
Set RS5 = DB3.OpenRecordset("Select * From " & RS4![ML] & " Where Code = '" & RS7!Subs & "';")
If RS5.RecordCount > 0 Then
RS3.AddNew
If RS3.RecordCount = A + 1 Then 'Заполняем только 1 строку
RS3![0] = RS6!Code
RS3![1] = N()
RS3![2] = RS5!Code
RS3![3] = RS5![Description]
End If
If RS![In] = 0 Then
RS3![4] = Coma(RS5![Price], 2)
RS2.FindFirst "ID = " & RS4!ID & ""
If RS![PD] = -1 Then RS3![4] = Coma(RS3![4] * (100 - RS2!D) / 100, 2)
If RS![OM] = -1 Then
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS!M) / 100, 2)
Else
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS2!M) / 100, 2)
End If
RS3![5] = RS4![PriceL]
RS3![6] = RS4![TimeL]
RS3![7] = RS4![ML]
Else
RS3![4] = Coma(RS5![Price], 2)
RS2.FindFirst "ID = " & RS4!ID & ""
If RS![PD] = -1 Then RS3![4] = Coma(RS3![4] * (100 - RS2!D) / 100, 2)
If RS![OM] = -1 Then
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS!M) / 100, 2)
Else
If RS![PM] = -1 Then RS3![4] = Coma(RS3![4] * (100 + RS2!M) / 100, 2)
End If
RS3![5] = Coma(RS5![Price] * (100 - RS2!D) / 100, 2)
RS3![6] = RS4![PriceL]
RS3![7] = RS4![TimeL]
RS3![8] = RS4![ML]
End If
RS3.Update
End If
RS4.MoveNext
Loop
RS7.MoveNext
Loop
'ОШИБКА ЗДЕСЬ!!!
'Добавляем дубликаты в таблицу
'Делаем цикл по таблицам дубликатов, если оригинал и надо смотреть дубликаты
If RS![DU] = -1 Then
If RS6![Description] = "Original" Then
Set RS7 = DB4.OpenDatabase("Select * Prices Where [Description] = 'Dublicat';") - - - ОШИБКА!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
If RS7.RecordCount > 0 Then
Do Until RS7.EOF
-
'Ищем в таблицe Сross код Дубликата по индексу и коду Оригинала
'открываем базы дубликатов
-
Добавляем данные
-
RS7.MoveNext
Loop
End If
End If
End If
Этот цикл еще не доделан, но суть не в этом!
'Выводим на экран
If RS3.RecordCount > 0 Then
MSFlexGrid1.Visible = True
RS3.MoveFirst
B = 1
MSFlexGrid1.Rows = RS3.RecordCount + 1
Do Until B > RS3.RecordCount
MSFlexGrid1.Row = B
A = 0
Do Until A > (IIf(RS![In] = 0, 7,

)
MSFlexGrid1.Col = A
Select Case A
Case 0
MSFlexGrid1.Text = IIf(RS3![0] Like "?*", RS3![0], "")
Case 1
MSFlexGrid1.Text = IIf(RS3![1] Like "?*", RS3![1], "")
Case 2
MSFlexGrid1.Text = IIf(RS3![2] Like "?*", RS3![2], "")
Case 3
MSFlexGrid1.Text = IIf(RS3![3] Like "?*", RS3![3], "")
Case 4
MSFlexGrid1.Text = IIf(RS3![4] Like "?*", RS3![4], "")
Case 5
MSFlexGrid1.Text = IIf(RS3![5] Like "?*", RS3![5], "")
Case 6
MSFlexGrid1.Text = IIf(RS3![6] Like "?*", RS3![6], "")
Case 7
MSFlexGrid1.Text = IIf(RS3![7] Like "?*", RS3![7], "")
Case 8
MSFlexGrid1.Text = IIf(RS3![8] Like "?*", RS3![8], "")
End Select
A = A + 1
Loop
B = B + 1
RS3.MoveNext
Loop
Else
MSFlexGrid1.Visible = False
End If
End If
End Sub