Создаю соединений с базой. Открываю два объекта на чтение - RecordsSetDB и запись - RecordsRecDB.
В конце, вылетает "Операция не допускается, если объект закрыт".
Какой объект? почему закрыт?
И вроде не оставляю открытых или закрытых соединений.
Если делаю маленький код, то вроде всё норм. Как только код растёт, то возникают такие проблемы.
- Код: Выделить всё
'--- Вывод в csv данных для раскроя в программу CutRite
'C:\Program Files (x86)\GeoS\K3-Мебель ПКМ 7.1\Data\PKM\Proto,C:\,D:\PKMProjects71\test\test.mdb,test,1,1,1,1
'========= Глобальные переменные =====================
'=====================================================
Dim ObjExcel ' объект Excel
Dim ObjCnMB ' объект - подключение к базе выгрузки
Dim Strings() ' Массив строк под различные нужды
Dim LastRow 'Последняя строка вывода
Dim dsp
Dim dvp
Dim mdf
'------------------------------------------------------------------------------
Function Start(ProtoPath, ProjPath, MebelBaseName, numc, dsp, dvp, mdf, Open )
' On Error Resume Next
Call Start0(ProtoPath, ProjPath, MebelBaseName, numc, dsp, dvp, mdf, Open )
If (Err.Number<>0) Then
Start = False
vb=MsgBox (CStr(Err.Description), 16, "Ошибка создания отчетов")
If ObjCnMB Is Not Nothing Then
ObjCnMB.Close
End If
If Not ObjExcel Is Nothing Then
ObjExcel.Visible = True
End If
Set ObjExcel = Nothing
Else
Start=True
End If
End Function
'------------------------------------------------------------------------------
Sub Start0(ProtoPath, ProjPath, MebelBaseName, numc, dsp, dvp, mdf, Open )
'---- Подключение к базе выгрузки
CnStr=MebelBaseName+";Persist Security Info=False"
Set ObjCnMB = ConnectDB(CnStr)
'---- Создаем объект Excel
' Set ObjExcel=CreateExcel()
'----- Заполняем документ
Call CutRite(dsp, dvp, mdf)
'--------- Завершение работы ------------------------------------
ObjCnMB.Close
ProjName = ProjPath+numc
' ObjExcel.Visible = True
' QuitExcel ProjName
End Sub
'------------------------------------------------------------------------------
'----------------- Заполняем документ
Sub CutRite(dsp, dvp, mdf)
SQLStr = "DROP TABLE CutRite"
On Error Resume Next
Set db = RecordsRecDB(ObjCnMB, SQLStr)
nP=26 ' количество полей таблицы
'--- Массив данных создания таблицы с нужными полями вывода
ReDim Strings(nP,1)
Strings(0,0)="Name CHAR(50)" '"Обозначение"
Strings(0,1)="PName" ' Имя функции
Strings(1,0)="MatName CHAR(50)" '"Код материала"
Strings(1,1)="PMatName" ' Имя функции
Strings(2,0)="Length REAL" '"Длина"
Strings(2,1)="PLength" ' Имя функции
Strings(3,0)="Width REAL" '"Ширина"
Strings(3,1)="PWidth" ' Имя функции
Strings(4,0)="Cnt INT" '"Количество"
Strings(4,1)="PCnt" ' Имя функции
Strings(5,0)="nad INT" '"над"
Strings(5,1)="Pnad" ' Имя функции
Strings(6,0)="pod INT" '"под"
Strings(6,1)="Ppod" ' Имя функции
Strings(7,0)="Dir INT" '"структура"
Strings(7,1)="PDir" ' Имя функции
Strings(8,0)="Barcode1 CHAR(30)" '"ШтрихКод1"
Strings(8,1)="PBarcode1" ' Имя функции
Strings(9,0)="Barcode2 CHAR(30)" '"ШтрихКод2"
Strings(9,1)="PBarcode2" ' Имя функции
Strings(10,0)="EdgeE CHAR(50)" '"впереди"
Strings(10,1)="PEdgeE" ' Имя функции
Strings(11,0)="EdgeD CHAR(50)" '"сзади"
Strings(11,1)="PEdgeD" ' Имя функции
Strings(12,0)="EdgeC CHAR(50)" '"слева"
Strings(12,1)="PEdgeC" ' Имя функции
Strings(13,0)="EdgeB CHAR(50)" '"справа"
Strings(13,1)="PEdgeB" ' Имя функции
Strings(14,0)="CommonPos INT" '"Номер детали"
Strings(14,1)="PCommonPos" ' Имя функции
Strings(15,0)="Pic CHAR(200)" '"Эскиз"
Strings(15,1)="PPic" ' Имя функции
Strings(16,0)="GrafEdge CHAR(20)" '"Графика кромки"
Strings(16,1)="PGrafEdge" ' Имя функции
Strings(17,0)="Article CHAR(50)" '"Код моделей"
Strings(17,1)="PArticle" ' Имя функции
Strings(18,0)="DecA CHAR(50)" '"Пласть A"
Strings(18,1)="PDecA" ' Имя функции
Strings(19,0)="DecF CHAR(50)" '"Пласть F"
Strings(19,1)="PDecF" ' Имя функции
Strings(20,0)="Paz CHAR(20)" '"ПазТорец"
Strings(20,1)="PPaz" ' Имя функции
Strings(21,0)="Freza CHAR(50)" '"Фрезеровка"
Strings(21,1)="PFreza" ' Имя функции
Strings(22,0)="endLen REAL" '"Конечная длина"
Strings(22,1)="PendLen" ' Имя функции
Strings(23,0)="endWid REAL" '"Конечная ширина"
Strings(23,1)="PendWid" ' Имя функции
Strings(24,0)="NumOrd INT" '"Номер заказа"
Strings(24,1)="PNumOrd" ' Имя функции
Strings(25,0)="Adress CHAR(50)" '"Адрес"
Strings(25,1)="PAdress" ' Имя функции
'------- Сформируем строку создания таблицы
SQLStr="CREATE TABLE CutRite ("
For i=0 To nP-2
SQLStr=SQLStr+Strings(i,0)+", "
Next
SQLStr=SQLStr+Strings(nP-1,0)+")"
Set rst = RecordsRecDB(ObjCnMB, SQLStr)
'------------------------------------------------------------------------------
'--- Отберём в общую таблицу только нужные панели и получим их UnitPos
If dsp="1" Then dsp="128" Else dsp="9999" End If
If dvp="1" Then dvp="37" Else dvp="9999" End If
If mdf="1" Then mdf="64" Else mdf="9999" End If
SQLStr="SELECT te.UnitPos FROM TElems AS te INNER JOIN TNNomenclature AS tnn ON te.PriceID = tnn.ID "& _
"WHERE (tnn.MatTypeID="+dvp+" Or tnn.MatTypeID="+mdf+" Or tnn.MatTypeID="+dsp+") AND (Exists (SELECT * FROM TLongs AS tl "& _
"WHERE tl.UnitPos=te.UnitPos))=False AND (Exists (SELECT * FROM TLongs AS tl WHERE tl.UnitPos=te.ParentPos "& _
"AND (tl.LongType=0 OR tl.LongType=2 OR tl.LongType=3 OR tl.LongType=4 OR tl.LongType=7)))=False "& _
"ORDER BY (tnn.MatTypeID) DESC, te.PriceID"
Set TABrst = RecordsSetDB(ObjCnMB, SQLStr) 'Таблица с UnitPos выбранных панелей
If Not TABrst Is Nothing Then
cnt = TABrst.RecordCount ' Получаем колличество строк в таблице
TABrst.MoveFirst
For i=1 To cnt ' Включаем счтчик для перебора панелей
UnitPos=TABrst.Fields(0)
tmp=IsPanFlat(UnitPos) ' Проверяем панель. Если не гнутая или гнутая, но гибкая, как ДВП.
If tmp=0 Then
For j=0 To nP-1 ' Включаем счётчик заполнения полей
func_name=Strings(j,1)&("("&UnitPos&")") ' Имя функции
valPan=EVal(func_name) ' Значение из функции
Pole=Mid(Strings(j,1),2) ' Имя поля в таблице. Удалили первый символ Р
tabs=tabs&Pole
If j<>nP-1 Then tabs=tabs&"," End If
vals=vals&valPan
If j<>nP-1 Then vals=vals&"," End If
valPan="NULL"
Pole=NULL
Next
SQLStr="INSERT INTO CutRite ("&tabs&") VALUES ("&vals&")"
Set RECrst = RecordsRecDB(ObjCnMB, SQLStr)
tabs=NULL
vals=NULL
End If
TABrst.MoveNext
RECrst.MoveNext
Next
End If
End Sub
'--------------------------------------------------------------------
'--- Функция проверяет панель на гнутость
'--------------------------------------------------------------------
Function IsPanFlat(n)
SQLStr="SELECT FormType FROM (TPanels tp LEFT JOIN TElems te ON tp.UnitPos=te.UnitPos) "& _
"LEFT JOIN TNNomenclature tnn ON te.PriceID = tnn.ID WHERE tp.UnitPos="&n&" AND tnn.MatTypeID<>37"
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
IsPanFlat=rst.Fields(0)
End Function
'--------------------------------------------------------------------
'--- Функция получает имя панели
'--------------------------------------------------------------------
Function PName(n)
SQLStr="SELECT Name FROM TElems WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PName="'"&rst.Fields(0)&"'"
End Function
'--------------------------------------------------------------------
'--- Функция получает имя материала панели
'--------------------------------------------------------------------
Function PMatName(n)
SQLStr="SELECT tnn.Name FROM TElems te LEFT JOIN TNNomenclature tnn ON te.PriceID=tnn.ID WHERE te.UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PMatName="'"&rst.Fields(0)&"'"
End Function
'--------------------------------------------------------------------
'--- Функция получает длину панели
'--------------------------------------------------------------------
Function PLength(n)
SQLStr="SELECT switch(tp.Dir<>90,te.XUNIT,tp.Dir=90,te.YUNIT) FROM "& _
"TElems te LEFT JOIN TPanels tp ON tp.UnitPos=te.UnitPos WHERE te.UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PLength=rst.Fields(0)
End Function
'--------------------------------------------------------------------
'--- Функция получает ширину панели
'--------------------------------------------------------------------
Function PWidth(n)
SQLStr="SELECT switch(tp.Dir=90,te.XUNIT,tp.Dir<>90,te.YUNIT) FROM "& _
"TElems te LEFT JOIN TPanels tp ON tp.UnitPos=te.UnitPos WHERE te.UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PWidth=rst.Fields(0)
End Function
'--------------------------------------------------------------------
'--- Функция получает количество панелей
'--------------------------------------------------------------------
Function PCnt(n)
SQLStr="SELECT Count FROM TElems WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PCnt=rst.Fields(0)
End Function
'--------------------------------------------------------------------
'--- Функция получает значения для поля nad
'--------------------------------------------------------------------
Function Pnad(n)
Pnad=0
End Function
'--------------------------------------------------------------------
'--- Функция получает значения для поля pod
'--------------------------------------------------------------------
Function Ppod(n)
Ppod=0
End Function
'--------------------------------------------------------------------
'--- Функция получает направление текстуры панелей
'--------------------------------------------------------------------
Function PDir(n)
SQLStr="SELECT IIf(Dir=0,1,IIf(Dir=-1,0,1)) FROM TPanels WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PDir=rst.Fields(0)
Else PDir=1
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает штрихкод1 панелей
'--------------------------------------------------------------------
Function PBarcode1(n)
SQLStr="SELECT te.HashCode&'_'&te.CommonPos&'A' FROM TElems te WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PBarcode1="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает штрихкод2 панелей
'--------------------------------------------------------------------
Function PBarcode2(n)
SQLStr="SELECT te.HashCode&'_'&te.CommonPos&'F' FROM TElems te WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PBarcode2="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает кромку торца E панели
'--------------------------------------------------------------------
Function PEdgeE(n)
SQLStr="SELECT tn.Name "& _
"FROM (SELECT idp.NumValue AS IDPoly, idl.NumValue AS IDLine, "& _
"idb.NumValue AS BandUnitPos, idp.UnitPos FROM (TParams AS idp "& _
"LEFT JOIN TParams AS idl ON (idp.Hold3=idl.Hold3) AND (idp.Hold1=idl.Hold1) "& _
"AND (idp.HoldTable=idl.HoldTable) AND (idp.UnitPos=idl.UnitPos)) "& _
"LEFT JOIN TParams AS idb ON (idp.Hold3=idb.Hold3) AND (idp.Hold1=idb.Hold1) "& _
"AND (idp.HoldTable=idb.HoldTable) AND (idp.UnitPos=idb.UnitPos) "& _
"WHERE idp.HoldTable='TPaths' AND idp.Hold1=1 AND idp.ParamName='IDPoly' "& _
"AND idl.ParamName='IDLine' AND idb.ParamName='BandUnitPos') AS bu, TNNomenclature AS tn, "& _
"TElems AS te WHERE ((((bu.BandUnitPos)=te.UnitPos) And ((te.PriceID)=tn.ID) "& _
"And ((bu.IDPoly)=1) And ((bu.IDLine)=5)) And bu.UnitPos="&n&")"
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PEdgeE="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает кромку торца D панели
'--------------------------------------------------------------------
Function PEdgeD(n)
SQLStr="SELECT tn.Name "& _
"FROM (SELECT idp.NumValue AS IDPoly, idl.NumValue AS IDLine, "& _
"idb.NumValue AS BandUnitPos, idp.UnitPos FROM (TParams AS idp "& _
"LEFT JOIN TParams AS idl ON (idp.Hold3=idl.Hold3) AND (idp.Hold1=idl.Hold1) "& _
"AND (idp.HoldTable=idl.HoldTable) AND (idp.UnitPos=idl.UnitPos)) "& _
"LEFT JOIN TParams AS idb ON (idp.Hold3=idb.Hold3) AND (idp.Hold1=idb.Hold1) "& _
"AND (idp.HoldTable=idb.HoldTable) AND (idp.UnitPos=idb.UnitPos) "& _
"WHERE idp.HoldTable='TPaths' AND idp.Hold1=1 AND idp.ParamName='IDPoly' "& _
"AND idl.ParamName='IDLine' AND idb.ParamName='BandUnitPos') AS bu, TNNomenclature AS tn, "& _
"TElems AS te WHERE ((((bu.BandUnitPos)=te.UnitPos) And ((te.PriceID)=tn.ID) "& _
"And ((bu.IDPoly)=1) And ((bu.IDLine)=1)) And bu.UnitPos="&n&")"
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PEdgeD="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает кромку торца C панели
'--------------------------------------------------------------------
Function PEdgeC(n)
SQLStr="SELECT tn.Name "& _
"FROM (SELECT idp.NumValue AS IDPoly, idl.NumValue AS IDLine, "& _
"idb.NumValue AS BandUnitPos, idp.UnitPos FROM (TParams AS idp "& _
"LEFT JOIN TParams AS idl ON (idp.Hold3=idl.Hold3) AND (idp.Hold1=idl.Hold1) "& _
"AND (idp.HoldTable=idl.HoldTable) AND (idp.UnitPos=idl.UnitPos)) "& _
"LEFT JOIN TParams AS idb ON (idp.Hold3=idb.Hold3) AND (idp.Hold1=idb.Hold1) "& _
"AND (idp.HoldTable=idb.HoldTable) AND (idp.UnitPos=idb.UnitPos) "& _
"WHERE idp.HoldTable='TPaths' AND idp.Hold1=1 AND idp.ParamName='IDPoly' "& _
"AND idl.ParamName='IDLine' AND idb.ParamName='BandUnitPos') AS bu, TNNomenclature AS tn, "& _
"TElems AS te WHERE ((((bu.BandUnitPos)=te.UnitPos) And ((te.PriceID)=tn.ID) "& _
"And ((bu.IDPoly)=1) And ((bu.IDLine)=3)) And bu.UnitPos="&n&")"
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PEdgeC="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает кромку торца B панели
'--------------------------------------------------------------------
Function PEdgeB(n)
SQLStr="SELECT tn.Name "& _
"FROM (SELECT idp.NumValue AS IDPoly, idl.NumValue AS IDLine, "& _
"idb.NumValue AS BandUnitPos, idp.UnitPos FROM (TParams AS idp "& _
"LEFT JOIN TParams AS idl ON (idp.Hold3=idl.Hold3) AND (idp.Hold1=idl.Hold1) "& _
"AND (idp.HoldTable=idl.HoldTable) AND (idp.UnitPos=idl.UnitPos)) "& _
"LEFT JOIN TParams AS idb ON (idp.Hold3=idb.Hold3) AND (idp.Hold1=idb.Hold1) "& _
"AND (idp.HoldTable=idb.HoldTable) AND (idp.UnitPos=idb.UnitPos) "& _
"WHERE idp.HoldTable='TPaths' AND idp.Hold1=1 AND idp.ParamName='IDPoly' "& _
"AND idl.ParamName='IDLine' AND idb.ParamName='BandUnitPos') AS bu, TNNomenclature AS tn, "& _
"TElems AS te WHERE ((((bu.BandUnitPos)=te.UnitPos) And ((te.PriceID)=tn.ID) "& _
"And ((bu.IDPoly)=1) And ((bu.IDLine)=7)) And bu.UnitPos="&n&")"
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
If Not rst Is Nothing Then
PEdgeB="'"&rst.Fields(0)&"'"
End If
End Function
'--------------------------------------------------------------------
'--- Функция получает номер панели
'--------------------------------------------------------------------
Function PCommonPos(n)
SQLStr="SELECT CommonPos FROM TElems WHERE UnitPos="&n
Set rst = RecordsSetDB(ObjCnMB, SQLStr)
PCommonPos=rst.Fields(0)
End Function
'---------------------------------------------------------------------
'-- Функция устанавливает соединение с базой данных
'---------------------------------------------------------------------
'-- Входные параметры
'-- ConnectionStr - строка подключения
'-- Выходные параметры:
'-- Функция возвращает значение - объект "соединение"
Function ConnectDB(ConnectionStr)
Set objCn = CreateObject("ADODB.Connection")
objCn.Provider = "Microsoft.Jet.OLEDB.4.0"
objCn.ConnectionString = "Data Source="+ConnectionStr
objCn.Open
Set ConnectDb=objCn
End Function
'---------------------------------------------------------------------
'-- Функция возвращает набор записей из базы данных
'---------------------------------------------------------------------
'-- Входные параметры
'-- SQLStr - строка SQL
'-- ObjDB - объект - соединение с БД
'-- Выходные параметры:
'-- Функция возвращает значение - объект "набор записей"
Function RecordsSetDB(ObjDB, SQLStr)
Set objRs = CreateObject("ADODB.Recordset")
objRs.CursorType = 3
objRs.Open SQLStr, ObjDB
Rows = objRs.RecordCount
If Rows < 1 Then
objRs.Close
Set RecordsSetDB=Nothing
Exit Function
End If
objRs.MoveFirst
Set RecordsSetDB=objRs
End Function
'---------------------------------------------------------------------
'-- Функция создаёт запись в базе данных
'---------------------------------------------------------------------
'-- Входные параметры
'-- SQLStr - строка SQL
'-- ObjDB - объект - соединение с БД
Function RecordsRecDB(ObjDB, SQLStr)
Set objRs = CreateObject("ADODB.Recordset")
objRs.CursorType = 3
objRs.Open SQLStr, ObjDB
Set RecordsRecDB=objRs
End Function
'---------------------------------------------------------------------