Установил скл 2012 под вин 2012, акс 2010 х64...

восстановил бэкап как есть в скл 2012, взял ранее созданный в акс2007 (тривью начало работать, скрин давал ранее) и ... сходу ошибки... на скрине запуск программы, автозапуск формы frmIzdelieTreeAPI..

причем приразворачивании бэкапа никаких плохих сообщений не было...

не знаю как быть...

и сразу чтоб потом не дожидаться указаний

несколько подзабыл, поэтому делал и так, результат тот же

Debug / Compile - скрин

опять же если при восстановлении базы из бэкапа нет сообщений об ошибке то я считаю что все нормально

насчет разницы 6 и 7 вба - это я упомянул ответ в мой адрес в одной из тем...

более конкретно пока не готов что ли бо объяснять, недостаточно изучил...

насчет моего вывода о ьезошибочном восстановлении бэкапа, посмотри пожалуйста так ли например представление восстановилось в 2012 скл...

как раз в это время менял (добавлял для совместимости ) в Declare Function на Declare PtrSafe Function, debug-compile перестал но выдал :

по памяти структура в диаграмме вроде бы такая же как и акс2007 и скл 2008:

чем могу:

Public Function OpenRecordset _
( _
rs As ADODB.Recordset, _
nRecords As Long, _
sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)

взял через копию прямо из отладчика в аксе

не понял насчет мутно, это текст а не принтскрин,

даю поный текс :

---------------

Option Compare Database
Option Explicit

' CurrentProject.BaseConnectionString
' PROVIDER=SQLOLEDB.1;
' INTEGRATED SECURITY=SSPI;PERSIST SECURITY INFO=FALSE;
' DATA SOURCE=***;INITIAL CATALOG=***

' CurrentProject.Connection.ConnectionString
' Provider=Microsoft.Access.OLEDB.10.0;Data Provider=SQLOLEDB.1;
' Persist Security Info=False;Integrated Security=SSPI;
' Data Source=***;Initial Catalog=***;

Public Function ConnectionInfo _
( _
sServerName As String, _
sDatabaseName As String _
)
Dim tv As New TaggedValues
sServerName = ""
sDatabaseName = ""
ConnectionInfo = True
tv.Text = Access.CurrentProject.BaseConnectionString
If tv.Exists("DATA SOURCE") Then
sServerName = tv.item("DATA SOURCE")
Else
ConnectionInfo = False
End If
If tv.Exists("INITIAL CATALOG") Then
sDatabaseName = tv.item("INITIAL CATALOG")
Else
ConnectionInfo = False
End If

End Function

Public Function OpenConnection _
( _
cnn As ADODB.Connection, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)
On Error Resume Next: Err.Clear

Dim iTryCount As Integer: iTryCount = 0
OpenConnection = False
If cnn Is Nothing Then Set cnn = New ADODB.Connection
If cnn.State = adStateOpen Then cnn.Close
If sServerName = "" Or sDatabaseName = "" Then
Call modSQL.ConnectionInfo(sServerName, sDatabaseName)
End If
On Error GoTo Err_Connect
cnn.CommandTimeout = iCommandTimeout
cnn.CursorLocation = adUseClient
cnn.Open _
"PROVIDER=SQLOLEDB.1;" & _
"INTEGRATED SECURITY=SSPI;" & _
"PERSIST SECURITY INFO=FALSE;" & _
"DATA SOURCE=" & sServerName & ";" & _
"INITIAL CATALOG=" & sDatabaseName & ";"
If cnn.State = adStateOpen Then
OpenConnection = True
Else
modForm.MsgBox _
"Подключение к серверу " & sServerName & " " & _
"и базе данных " & sDatabaseName & " не выполнено.", _
vbExclamation + vbOKOnly, _
"Ошибка подключения к серверу и базе данных"
OpenConnection = False
End If
On Error GoTo 0
Exit Function

Err_Connect:
If iTryCount > 1 Then
OpenConnection = False
GoTo ERR_LABEL
End If
iTryCount = iTryCount + 1
Call ConnectionInfo(sServerName, sDatabaseName)
Resume

ERR_LABEL:
modForm.MsgBox _
"Ощибка " & Err.Number & ": " & Err.Description, _
vbExclamation + vbOKOnly, _
"Ошибка подключения к базе данных"
OpenConnection = False
On Error GoTo 0
Exit Function

End Function

Public Function OpenRecordset _
( _
rs As ADODB.Recordset, _
nRecords As Long, _
sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)
On Error Resume Next: Err.Clear

Dim cnnLocal As ADODB.Connection
nRecords = 0
OpenRecordset = False
If IsNull(cnn) Then
Call modSQL.OpenConnection(cnnLocal, sServerName, sDatabaseName, iCommandTimeout)
Else
Set cnnLocal = cnn
End If
Set rs = New ADODB.Recordset
rs.CursorType = adOpenKeyset
rs.CursorLocation = adUseClient
rs.Open sSQL, cnnLocal
nRecords = rs.RecordCount
If Err.Number <> 0 Then
Call modError.ErrorMessage( _
9101401, _
"Ошибка выполнения запроса к серверу" & vbNewLine & vbNewLine & _
"SQL=" & sSQL)
Err.Clear
' Рекордсет не был открыт по причине ЛЮБОЙ ошибки
OpenRecordset = False
Else
' True возвращается даже если открытый рекордсет не имеет строк
OpenRecordset = True
End If

On Error GoTo 0
End Function

Public Function ReadValue _
( _
sFieldName As String, vFieldValue As Variant, sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)
On Error Resume Next: Err.Clear

Dim cnnLocal As ADODB.Connection, bOpenConnection As Boolean
Dim rs As ADODB.Recordset, n As Long, v As Variant

If IsNull(cnn) Then
bOpenConnection = True
Call modSQL.OpenConnection(cnnLocal, sServerName, sDatabaseName, iCommandTimeout)
Else
bOpenConnection = False
Set cnnLocal = cnn
End If
If modSQL.OpenRecordset(rs, n, sSQL, cnnLocal, sServerName, sDatabaseName) Then
If Err.Number <> 0 Then
Call modError.ErrorMessage(Err.Number, Err.Description)
Err.Clear
vFieldValue = Null
ReadValue = False
ElseIf rs.EOF Or rs.BOF Then
vFieldValue = Null
ReadValue = False
Else
vFieldValue = Null
vFieldValue = rs.Fields(sFieldName)
ReadValue = Not IsNull(vFieldValue)
End If
End If
rs.Close: Set rs = Nothing
If bOpenConnection Then
cnnLocal.Close: Set cnnLocal = Nothing
End If

On Error GoTo 0
End Function

Public Function ExecuteCommand _
( _
nRecords As Long, _
sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800, _
Optional bShowError As Boolean = True _
)
On Error Resume Next: Err.Clear

Dim cnnLocal As ADODB.Connection, bOpenConnection As Boolean
If IsNull(cnn) Then
bOpenConnection = True
Call modSQL.OpenConnection(cnnLocal, sServerName, sDatabaseName, iCommandTimeout)
Else
bOpenConnection = False
Set cnnLocal = cnn
End If
nRecords = 0
cnnLocal.Execute sSQL, nRecords
If Err.Number <> 0 Then
If bShowError Then
Call modError.ErrorMessage(Err.Number, Err.Description)
End If
Err.Clear
ExecuteCommand = False
Else
ExecuteCommand = True
End If

If bOpenConnection Then
cnnLocal.Close: Set cnnLocal = Nothing
End If

On Error GoTo 0
End Function

Public Function ExecuteInsert _
( _
vObjectID As Variant, _
sInsertSQL As String, _
sTableName As String, sTableDescription As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)
On Error Resume Next: Err.Clear

Dim nInsertRecords As Long, nIdentityRecords As Long

nInsertRecords = 0
nIdentityRecords = 0
vObjectID = -1
ExecuteInsert = False

Dim sTableNameTruncate As String, sIdentitySQL As String

If Left(sTableName, 3) = "dbo" Then
sTableNameTruncate = "dbo." & Replace(sTableName, "dbo.", "")
Else
sTableNameTruncate = sTableName
End If

sIdentitySQL = _
"SELECT IDENT_CURRENT('" & sTableNameTruncate & " '), " & _
"SCOPE_IDENTITY()"

Dim cnnLocal As ADODB.Connection
Dim bOpenConnection As Boolean
If IsNull(cnn) Then
bOpenConnection = True
Call modSQL.OpenConnection(cnnLocal, sServerName, sDatabaseName, iCommandTimeout)
Else
bOpenConnection = False
Set cnnLocal = cnn
End If

Dim rsIdentity As ADODB.Recordset
Call modSQL.ExecuteCommand(nInsertRecords, sInsertSQL, cnnLocal)
Call modSQL.OpenRecordset(rsIdentity, nIdentityRecords, sIdentitySQL, cnnLocal)

If Left(sInsertSQL, 7) = "INSERT " And (Err.Number <> 0 Or nInsertRecords <> 1 Or nIdentityRecords <> 1) Then
modError.ErrorMessage _
9060701, _
"Запись в таблицу " & _
sTableName & " " & sTableDescription & " " & _
"не была добавлена."
Err.Clear: GoTo END_PROCEDURE
ElseIf Left(sInsertSQL, 4) = "EXEC" And (Err.Number <> 0 Or nIdentityRecords <> 1) Then
modError.ErrorMessage _
9060701, _
"Запись в таблицу " & _
sTableName & " " & sTableDescription & " " & _
"не была добавлена."
Err.Clear: GoTo END_PROCEDURE
End If
If rsIdentity.Fields(0) <> rsIdentity.Fields(1) Then
modError.ErrorMessage 9060702, _
"При добавлении в таблицу " & _
sTableName & " " & sTableDescription & " " & _
"неправильно был определен уникальный код записи (счетчик)."
Err.Clear: GoTo END_PROCEDURE
Else
vObjectID = rsIdentity.Fields(0)
ExecuteInsert = True
End If

END_PROCEDURE:
rsIdentity.Close: Set rsIdentity = Nothing
If bOpenConnection Then
cnnLocal.Close: Set cnnLocal = Nothing
End If

On Error GoTo 0
End Function

Public Function ExecuteUpdate _
( _
sUpdateSQL As String, _
Optional sTableName As String = "", Optional sTableDescription As String = "", _
Optional cnn = Null, Optional sServerName As String = "", Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)
On Error Resume Next: Err.Clear

Dim nUpdateRecords As Long

nUpdateRecords = 0
ExecuteUpdate = False

Dim cnnLocal As ADODB.Connection
Dim bOpenConnection As Boolean
If IsNull(cnn) Then
bOpenConnection = True
Call modSQL.OpenConnection(cnnLocal, sServerName, sDatabaseName, iCommandTimeout)
Else
bOpenConnection = False
Set cnnLocal = cnn
End If
Call modSQL.ExecuteCommand(nUpdateRecords, sUpdateSQL, cnn)

If Err.Number <> 0 Then
If sTableName <> "" And sTableDescription <> "" Then
modError.ErrorMessage _
9010703, _
"Ошибка при записи данных (обновлении записи) в таблицу " & _
sTableName & " " & sTableDescription
End If
Err.Clear
Else
ExecuteUpdate = True
End If
If bOpenConnection Then
cnnLocal.Close: Set cnnLocal = Nothing
End If

On Error GoTo 0
End Function

Public Function ToString(v As Variant) As String

Dim VALUE: VALUE = v
Dim i As Integer: i = 0

Begin_Label:
If IsNull(VALUE) Then
ToString = "NULL"
Else
Select Case VarType(VALUE)
Case vbEmpty, vbNull
ToString = "NULL"
Case vbInteger, vbLong
ToString = CStr(v)
Case vbSingle, vbDouble, vbDecimal, vbCurrency
If VALUE = -1E+50 Then
ToString = "NULL"
Else
Dim sDecimalSeparator As String, sThouthandSeparator As String
sDecimalSeparator = Mid(Format(0, "0.0"), 2, 1)
sThouthandSeparator = Mid(Format(1000, "0,000"), 2, 1)
ToString = CStr(v)
ToString = Replace(ToString, sDecimalSeparator, "!")
ToString = Replace(ToString, sThouthandSeparator, "")
ToString = Replace(ToString, "!", ".")
End If
Case vbDate
Date_Label:
If v = modDate.EMPTY_DATE Then
ToString = "NULL"
Else
ToString = "'" & Format(v, "yyyymmdd hh:mm:ss") & "'"
End If
Case vbString
If InStr(VALUE, "-") > 0 _
Or InStr(VALUE, "/") > 0 _
Or InStr(VALUE, ".") > 0 Then

If InStr(InStr(VALUE, "-") + 1, VALUE, "-") > 0 _
Or InStr(InStr(VALUE, "/") + 1, VALUE, "/") > 0 _
Or InStr(InStr(VALUE, ".") + 1, VALUE, ".") > 0 Then
If IsDate(VALUE) Then
VALUE = CDate(VALUE)
GoTo Date_Label
End If
End If
End If
If UCase(VALUE) = "NULL" Then
ToString = "NULL"
Else
ToString = "'" & Replace(VALUE, "'", "''") & "'"
End If
Case vbBoolean
ToString = IIf(v, "-1", "0")
Case vbObject
On Error Resume Next
VALUE = v.VALUE
If Err.Number <> 0 Then
Err.Clear
ToString = "NULL"
Else
i = i + 1
If i < 16 Then
GoTo Begin_Label
Else
ToString = "NULL"
End If
End If
Case Else
ToString = "NULL"
End Select
End If

End Function

Public Function Add(v As Variant, Optional bIsLast As Boolean = False) As String

Add = ToString(v)
If Not bIsLast Then
Add = Add & ", "
Else
Add = Add & " "
End If

End Function

Public Function AddParameter(v As Variant, Optional bIsLast As Boolean = False, _
Optional sDelimiter As String = ",") As String

AddParameter = ToString(v)
If Not bIsLast Then
AddParameter = AddParameter & sDelimiter & " "
Else
AddParameter = AddParameter & " "
End If

End Function

' Ф-ии добавления параметра заданного типа нужны, если в качестве аргумента используется
' свободный контрол, который может принимать значение NULL
' Для bound контролов и непустых значений ф-ия AddParameter сама выясняет нужный тип параметра
Public Function AddString(vString As Variant, Optional bIsLast As Boolean = False) As String
If VarType(vString) = vbEmpty Then vString = Null
If IsNull(vString) Then
AddString = AddParameter(vString, bIsLast)
Else
Dim s As Variant
s = "@" + IIf(IsNull(vString), Null, CStr(Nz(vString, "")))
s = AddParameter(s, bIsLast)
AddString = Mid(s, 1, 1) & Mid(s, 3, Len(s) - 2)
End If
End Function
Public Function AddDate(vDate As Variant, Optional bIsLast As Boolean = False) As String
If VarType(vDate) = vbEmpty Then vDate = Null
If vDate = "" Then vDate = Null
If vDate = 0 Then vDate = Null
AddDate = AddParameter(IIf(IsNull(vDate), Null, CDate(Nz(vDate, #1/1/1900#))), bIsLast)
End Function
Public Function AddDateTime(vDate As Variant, Optional bIsLast As Boolean = False) As String
If VarType(vDate) = vbEmpty Then vDate = Null
If VarType(vDate) = vbNull Then
AddDateTime = AddParameter(Null, bIsLast)
Else
AddDateTime = "'" & Format(CDate(vDate), "yyyymmdd hh:mm:ss") & "'"
End If
If Not bIsLast Then AddDateTime = AddDateTime & ", "
End Function
Public Function AddLong(vLong As Variant, Optional bIsLast As Boolean = False) As String
If VarType(vLong) = vbEmpty Then vLong = Null
AddLong = AddParameter(IIf(IsNull(vLong), Null, CLng(Nz(vLong, 0))), bIsLast)
End Function
Public Function AddDecimal(vDecimal As Variant, Optional bIsLast As Boolean = False) As String
If VarType(vDecimal) = vDecimal Then vDecimal = Null
AddDecimal = AddParameter(IIf(IsNull(vDecimal), Null, CDbl(Nz(vDecimal, 0))), bIsLast)
End Function

Public Function ParseSelectFromWhereOrderBy(sSQL As String, sSelect As String, sFrom As String, sWhere As String, sOrderBy As String)

Dim iSelect As Integer, iFrom As Integer, iWhere As Integer, iOrderBy As Integer

Dim s As String
s = Replace(sSQL, Chr(9), " ")
s = Replace(s, Chr(13), " ")
s = Replace(s, Chr(10), " ")
iSelect = InStr(1, s, "SELECT "): sSelect = ""
iFrom = InStrRev(s, " FROM "): sFrom = ""
iWhere = InStrRev(s, " WHERE "): sWhere = ""
iOrderBy = InStrRev(s, " ORDER BY "): sOrderBy = ""

If iSelect = 0 Or iFrom = 0 _
Or (iFrom <= iSelect) _
Or (iWhere > 0 And iWhere <= iFrom) _
Or (iOrderBy > 0 And iOrderBy <= iWhere) _
Then
ParseSelectFromWhereOrderBy = False
Exit Function
End If

sSelect = Trim(Mid(s, iSelect + Len("SELECT "), iFrom - (iSelect + Len("SELECT "))))
If iWhere > 1 And iOrderBy > 1 Then
sFrom = Trim(Mid(s, iFrom + Len(" FROM "), iWhere - (iFrom + Len(" FROM "))))
sWhere = Trim(Mid(s, iWhere + Len(" WHERE "), iOrderBy - (iWhere + Len(" WHERE "))))
sOrderBy = Mid(s, iOrderBy + Len(" ORDER BY "))
ElseIf iWhere > 1 And iOrderBy = 0 Then
sFrom = Trim(Mid(s, iFrom + Len(" FROM "), iWhere - (iFrom + Len(" FROM "))))
sWhere = Mid(s, iWhere + Len(" WHERE "))
ElseIf iWhere = 0 And iOrderBy > 1 Then
sFrom = Trim(Mid(s, iFrom + Len(" FROM "), iOrderBy - (iFrom + Len(" FROM "))))
sOrderBy = Mid(s, iOrderBy + Len(" ORDER BY "))
Else ' iWhere = 0 And iOrderBy = 0
sFrom = Trim(Mid(s, iFrom + Len(" FROM ")))
End If

End Function

Public Sub Test_ParseSelectFromWhereOrderBy()

Dim sSQL As String, sSelect As String, sFrom As String, sWhere As String, sOrderBy As String
sSQL = "SELECT * FROM TAB WHERE id > 0 ORDER BY sName"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

sSQL = "SELECT * FROM TAB ORDER BY sName"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

sSQL = "SELECT * FROM TAB WHERE id > 0"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

sSQL = "SELECT * FROM TAB"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

sSQL = "select sParusCustomerCode = '*', sParusCustomerAlias = '<Все мнемокоды>', sCondition = '1=1'" & vbNewLine & _
"union all select sParusCustomerCode, sParusCustomerAlias, 'sParusCustomerCode=''{LIST}'''" & vbNewLine & _
"from qrParusCustomerCodeBind1" & vbNewLine & _
"order by sParusCustomerCode"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

End Sub

Public Function JoinSelectFromWhereOrderBy _
( _
sSQL As String, _
sSelect As String, _
sFrom As String, _
Optional sWhere As String = "", _
Optional sOrderBy As String = "", _
Optional bDistinct As Boolean = False _
)

If Len(sSelect) = 0 Or Len(sFrom) = 0 Then
JoinSelectFromWhereOrderBy = False
Exit Function
End If
sSQL = "SELECT "
If bDistinct Then sSQL = sSQL & "DISTINCT "
sSQL = sSQL & sSelect
sSQL = sSQL & " FROM " & sFrom
If Len(sWhere) > 0 Then sSQL = sSQL & " WHERE " & sWhere
If Len(sOrderBy) > 0 Then sSQL = sSQL & " ORDER BY " & sOrderBy
JoinSelectFromWhereOrderBy = True

End Function

Public Function JoinFromWhereOrderBy _
( _
sSQL As String, _
sFrom As String, _
Optional sWhere As String = "", _
Optional sOrderBy As String = "" _
)

JoinFromWhereOrderBy = JoinSelectFromWhereOrderBy(sSQL, "*", sFrom, sWhere, sOrderBy)

End Function

Public Sub Test_JoinSelectFromWhereOrderBy()

Dim sSQL As String, sSelect As String, sFrom As String, sWhere As String, sOrderBy As String
sSQL = "SELECT * FROM TAB WHERE id > 0 ORDER BY sName"
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

JoinSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

JoinSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere, sOrderBy, True
Debug.Print "|" & sSQL & "|" & sSelect & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

JoinFromWhereOrderBy sSQL, sFrom, sWhere, sOrderBy
Debug.Print "|" & sSQL & "|" & sFrom & "|" & sWhere & "|" & sOrderBy & "|"

End Sub

Public Function AddWhereAnd(sWhere1 As String, sWhere2 As String)

AddWhereAnd = sWhere1
If Len(sWhere1) > 0 And Len(sWhere2) > 0 Then
AddWhereAnd = "(" & sWhere1 & ") AND (" & sWhere2 & ")"
ElseIf Len(sWhere1) > 0 And Len(sWhere2) = 0 Then
AddWhereAnd = sWhere1
ElseIf Len(sWhere1) = 0 And Len(sWhere2) > 0 Then
AddWhereAnd = sWhere2
Else
AddWhereAnd = ""
End If

End Function

Public Function AddWhere(sSQL As String, sWhere As String)

Dim sSQL_Local As String, sSelect As String, sFrom As String, sWhere_Local As String, sOrderBy As String
ParseSelectFromWhereOrderBy sSQL, sSelect, sFrom, sWhere_Local, sOrderBy
sWhere = AddWhereAnd(sWhere_Local, sWhere)
JoinSelectFromWhereOrderBy sSQL_Local, sSelect, sFrom, sWhere, sOrderBy
AddWhere = sSQL_Local

End Function

Public Function Test_AddWhere()

Dim sSQL As String, sWhere As String
sSQL = "SELECT a, b FROM tbl WHERE 1=1 AND 1=2"
sWhere = "ID=123"

Debug.Print AddWhere(sSQL, sWhere)

End Function

----

заменил
Public Function OpenRecordset _
( _
rs As ADODB.Recordset, _
nRecords As Long, _
sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)

на

Public Function OpenRecordset _
( _
rs As ADODB.Recordset, _
nRecords As Long Ptr , _
sSQL As String, _
Optional cnn = Null, _
Optional sServerName As String = "", _
Optional sDatabaseName As String = "", _
Optional iCommandTimeout As Integer = 800 _
)

заменил везде, ошибка исчезла, но появилась другая: nCount - на что заменить пока не нашел...

Программист-Любитель,

спасибо, а я уже многое что перелопатил что ж такое nCount пока не нашел, ну а если это переменные то надо пошукать

Set tv = CustomTreeView

Dim nCount As Long: nCount = -1
Dim sSQL As String: sSQL = "SELECT * FROM qrNodeElement WHERE iElementID=" & Me.iElementID
Dim rs As ADODB.Recordset

что ж они получается Long тоже заменили