Private Sub cmdOK_Click()
    On Error GoTo erm
    Set cnMain = New ADODB.Connection
    cnMain.ConnectionString =  "FILE NAME="  & App.Path & IIf(Right(App.Path,  1 ) =  "\" ,  "", " \ ") & apcUDL_File
    cnMain.CursorLocation = adUseClient
    cnMain.Open , txtName, txtPassw
        
    Dim cmdRole As New ADODB.Command, rs As ADODB.Recordset
    With cmdRole
        .ActiveConnection = cnMain
        .CommandType = adCmdText
        .CommandText = " SET NOCOUNT ON "
        .Execute
        .CommandText = " SELECT USER_ID() AS id "
        Set rs = .Execute
        IdUser = rs!id
        .CommandText = " EXEC sp_setapprole 'AppRole', 'Ax15bGkN0v' "
        .Execute
    End With
    
    
    frmMain.Show
    Unload Me
    Exit Sub
erm:
    Dim ert$, cer As ADODB.Error
    If cnMain.Errors.Count <> 0  Then
        For Each cer In cnMain.Errors
            If ert$ <> vbNullString Then
                ert$ = ert$ & vbCrLf
            End If
            If cer.Number = - 2147467259  Then
                    ert$ = "Истёк период ожидания соединения с БД "
            ElseIf cer.NativeError = 18456  Then
                    ert$ = "Имя пользователя и (или) пароль ошибочны "
            ElseIf cer.NativeError = 4060  Then
                    ert$ = "База данных отсутствует "
            Else
                    ert$ = ert$ & cer.Description & vbCrLf & "  ( " & CStr(cer.Number) & "  /  " & CStr(cer.NativeError) & " )   " & cer.Source & vbCrLf
            End If
        Next
    Else
        Select Case Err.Number
            Case 432 
                ert$ = "Отсутствует файл параметров соединения с БД " & vbCrLf & Mid$(cnMain.ConnectionString, InStr(cnMain.ConnectionString, " = ") + 1 )
            Case Else
                ert$ = Err.Description & " ( " & CStr(Err.Number) & " ) "
        End Select
    End If
    cnMain.Errors.Clear
    MsgBox ert$, vbCritical, " Ошибка соединения"
End Sub