Public Function Create_spRecordset(CheckRecordCount As Byte, _
                                                 CmdName As String, _
                                                 IndentParams As Byte, _
                                                 Frm As Form, _
                                                 ByRef ADORS As ADODB.Recordset) as Long
' --CheckRecordCount = 1 проверять на пустой рекодсет, 0 - не проверять '
' --CmdName - имя хранимой процедуры '
' --IndentParams - какой режим формы (какой набор параметров считать у формы) '
' --Frm - ссылка на форму '
' --AdoRs - возвращаемый рекордсет '
    Dim Cmd As ADODB.Command
    Dim prm As ADODB.Parameter
    Dim Ers As ADODB.Errors
On Error GoTo Er
    Create_spRecordset =  0 
    Set Cmd = New ADODB.Command
    Cmd.CommandText = CmdName
    Cmd.CommandType = adCmdStoredProc
    Cmd.Prepared = False
    Set prm = Cmd.CreateParameter("RETVALUE", adInteger, adParamReturnValue)
    Cmd.Parameters.Append prm
    If Frm.GetParam(Cmd, IndentParams) Then '-- считываю параметры из данной формы '
        If (AdoCn Is Nothing) Then     
            InitConnection
        End If
        Set Cmd.ActiveConnection = AdoCn 
        Call Cmd.ActiveConnection.Errors.Clear
        ADORS.CursorLocation = adUseClient
        ADORS.CursorType = adOpenStatic
        ADORS.LockType = adLockReadOnly
        Set ADORS = Cmd.Execute     ' <--------- !!![/color] '
        Set ADORS.ActiveConnection = Nothing
        If ADORS.State = adStateClosed Then
            Set Ers = Cmd.ActiveConnection.Errors
            Set ADORS = Nothing
            Create_spRecordset = - 1 
            Call RegisterUserError(Cmd.Parameters( 0 ).Value, Ers, Frm.Name)
        End If
        If CheckRecordCount And ADORS.RecordCount =  0  Then
            Create_spRecordset = - 1 
            MsgBox "Нет записей!", vbCritical, "Результат"
        End If
    End If
Ex: Set Ers = Nothing
    Set prm = Nothing
    Set Cmd = Nothing
    Exit function
Er:
    Create_spRecordset = Err.NUMBER
'    Set Prm = Nothing '
'    Set Ers = Nothing '
'    Set CMD = Nothing '
    IF (MsgBox(Err.Number & "," & Err.Description & vbcrlf _
           "Продолжать?",vbYesNo) = vbYes) Then
           Resume Next
    Else 
           Resume Ex
    End if
End Function

Private AdoCn As ADODB.Connection
 
Public Sub InitConnection()
    Set AdoCn = New ADODB.Connection
    AdoCn.CursorLocation = adUseClient
'    AdoCn.ConnectionString = "ODBC;Description=...;" _
        & "DRIVER=SQL Server;SERVER=...;DATABASE=...;" _
        & "LANGUAGE=us_english;Trusted_Connection=Yes;"   '
    AdoCn.ConnectionString = "SQLOLEDB.1;Description=...;" _
        & "DRIVER=SQL Server;SERVER=...;DATABASE=...;" _
        & "LANGUAGE=us_english;Trusted_Connection=Yes;"
    AdoCn.Open
End Sub

    Dim Rs As New ADODB.Recordset
On Error GoTo Er
    If Create_spRecordset( 0 , "spSpecHierarhRS", IndentParams, Me, Rs) =  0  Then
         FillResTree  0 , Rs, Me!DetailTRee, BranchCode, ImgOffset
         FillResTree  0 , Rs.NextRecordset, Me!SpecTree, BranchCode, ImgOffset
...

Dim Rs As New ADODB.Recordset
   On Error GoTo Er
   If Create_spRecordset( 0 , "spSpecHierarhRS", IndentParams, Me, Rs) =  0  Then
         FillResTree  0 , Rs, Me!DetailTRee, BranchCode, ImgOffset
         set Rs=Rs.NextRecordset 
        FillResTree  0 , Rs, Me!SpecTree, BranchCode, ImgOffset

   Dim Rs As New ADODB.Recordset
   Dim Rs2 as New Adodb.Recordset
   On Error GoTo Er
   If Create_spRecordset( 0 , "spSpecHierarhRS", IndentParams, Me, Rs) =  0  Then
         FillResTree  0 , Rs, Me!DetailTRee, BranchCode, ImgOffset
         set Rs2=Rs.NextRecordset 
        FillResTree  0 , Rs2, Me!SpecTree, BranchCode, ImgOffset

Public Function Create_spRecordset3(CheckRecordCount As Byte, CmdName As String, _
            IndentParams As Byte, Frm As Form, ByRef Rs1 As ADODB.Recordset, _
            ByRef Rs2 As ADODB.Recordset, ByRef Rs3 As ADODB.Recordset) As Long
    ...
        Set Rs1 = Cmd.Execute
        Set Rs2 = Rs1.NextRecordset
        Set Rs3 = Rs2.NextRecordset
        Set Rs1.ActiveConnection = Nothing
    ...

end function