...
Dim Ers as ADODB.Errors
        ...
        Set Rs1 = Cmd.Execute
        Set Rs1.ActiveConnection = Nothing
        If Rs1.state = adStateClosed Then
            Set Ers = Cmd.ActiveConnection.Errors
            Create_spRecordset = - 1 
            Set Rs1 = Nothing
            Call RegisterUserError(Cmd.Parameters( 0 ).Value, Ers, Frm.Name)
        End If
        If CheckRecordCount And Rs1.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
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical
    Resume Ex
End Function

Function RegisterUserError(ErrorValue As Long, CurrentErr As ADODB.Errors, HyIsCalling As String)
    MsgBox "Ошибка " & str(ErrorValue) & vbCrLf _
        & CurrentErr.Item( 0 ).Description, vbExclamation, _
        "При выполнении хр.проц. " & HyIsCalling
End Function