Private Sub CommandButton1_Click()
On Error GoTo errline
Dim lgn As String, pwd As String, level As String
    lgn = Trim(ComboBox1.Text)
    pwd = Trim(TextBox1.Text)
    If inlist("", lgn, pwd) Then
        MsgBox "Заполните поля", vbInformation, "Сообщение"
        Exit Sub
    End If
    
    sqltxt = "select * from logins where login=" & quote(lgn) & " and password=" & quote(pwd)
    СоздатьНаборЗаписей cns, sqltxt
    ПроверитьНаПустоту cn, rs
    
    If pusto Then
        MsgBox "Неверный логин или пароль", vbInformation, "Сообщение"
        Exit Sub
    End If
    
    level = Trim(rs.Fields("group").Value)
    УничтожитьНаборЗаписей cn, rs
    Select Case level
    Case "Админ"
        Unload Me
        With MenuAdmin
            .Show 0
        End With
    Case "Оператор"
        Unload Me
        With MenuOper
            .Show 0
        End With
    Case "Директор"
        Unload Me
        With MenuDir
            .Show 0
        End With
    Case "Менеджер"
        Unload Me
        With MenuMng
            .Show 0
        End With
    End Select
Exit Sub
errline:
ОбработатьОшибкуЗапроса cn, rs
End Sub

Public Sub СоздатьНаборЗаписей(ByVal CnStr As String, ByVal querytext As String)
Set cn = CreateObject("ADODB.Connection")
cn.Mode = adModeReadWrite
cn.Open CnStr
Set rs = CreateObject("ADODB.Recordset")
rs.CursorType = adOpenStatic
rs.LockType = adLockBatchOptimistic
Set rs = cn.Execute(querytext)
End Sub
Public Sub ПроверитьНаПустоту(ByVal cntn As Connection, ByVal rst As Recordset)
If rst.BOF = True And rst.EOF = True Then
    rst.Close
    Set rst = Nothing
    cntn.Close
    Set cntn = Nothing
    pusto = True
Else
    pusto = False
End If
End Sub
Public Sub УничтожитьНаборЗаписей(ByVal cntn As Connection, ByVal rst As Recordset)
rst.Close
Set rst = Nothing
cntn.Close
Set cntn = Nothing
End Sub
Public Sub ОбработатьОшибкуЗапроса(ByVal cntn As Connection, ByVal rst As Recordset)
If Not rst Is Nothing Then
    If rst.State = adStateOpen Then
        rst.Close
    End If
Set rst = Nothing
End If
errmsg = ""
If Not cntn Is Nothing Then
    For Each adoerr In cntn.Errors
        errmsg = errmsg & vbCr & "Номер ошибки: " & CStr(adoerr.Number)
        errmsg = errmsg & vbCr & "Описание ошибки: " & adoerr.Description
    Next
    cntn.Errors.Clear
    If cntn.State = adStateOpen Then
        cntn.Close
    End If
    Set cntn = Nothing
End If
If errmsg = "" Then
    errmsg = errmsg & vbCr & "Номер ошибки: " & CStr(Err.Number)
    errmsg = errmsg & vbCr & "Описание ошибки: " & Err.Description
End If
MsgBox errmsg
End Sub