Кодик на Аксесик VBA 2

ФОРМА СМЕНА ПАРОЛЯ

Private Sub btnСохранить_Click()

    Dim conn As Object

    Dim rs As Object

    Dim strConn As String

    Dim strSQL As String

    Dim СтарыйПароль As String

    Dim НовыйПароль As String

    Dim ПодтверждениеПароля As String

    СтарыйПароль = Nz(Me.СтарыйПароль.Value, "")

    НовыйПароль = Nz(Me.НовыйПароль.Value, "")

    ПодтверждениеПароля = Nz(Me.ПодтверждениеПароля.Value, "")

    If Trim(СтарыйПароль) = "" Or Trim(НовыйПароль) = "" Or Trim(ПодтверждениеПароля) = "" Then

        MsgBox "Заполните все поля."

        Exit Sub

    End If

    If НовыйПароль <> ПодтверждениеПароля Then

        MsgBox "Новый пароль и подтверждение не совпадают."

        Exit Sub

    End If

    strConn = "Provider=SQLOLEDB;Data Source=DO_ZAVRTA\MS;Initial Catalog=HotelSystem;Integrated Security=SSPI;"

    Set conn = CreateObject("ADODB.Connection")

conn.Open strConn

    strSQL = "SELECT * FROM [users] WHERE login = '" & Replace(ТекущийЛогин, "'", "''") & "'"

    Set rs = CreateObject("ADODB.Recordset")

rs.Open strSQL, conn, 1, 3

    If rs.EOF Then

        MsgBox "Пользователь не найден."

    ElseIf rs.Fields("password").Value <> СтарыйПароль Then

        MsgBox "Старый пароль введен неверно."

    Else

        rs.Fields("password").Value = НовыйПароль

        rs.Update

        MsgBox "Пароль успешно изменен."

        DoCmd.Close acForm, Me.Name

    End If

    rs.Close

    conn.Close

    Set rs = Nothing

    Set conn = Nothing

End Sub

Private Sub Form_Close()

    Dim conn As Object

    Dim strConn As String

    Dim updateSQL As String

    If ТекущийЛогин = "" Then Exit Sub

    strConn = "Provider=SQLOLEDB;Data Source=DO_ZAVRTA\MS;Initial Catalog=HotelSystem;Integrated Security=SSPI;"

    Set conn = CreateObject("ADODB.Connection")

conn.Open strConn

    updateSQL = "UPDATE [users] SET account_confirmed = 1 WHERE login = '" & Replace(ТекущийЛогин, "'", "''") & "'"

    conn.Execute updateSQL

    conn.Close

    Set conn = Nothing

End Sub

ФОРМА РЕДАКТИРОВАНИЕ/ДОБАВЛЕНИЯ ПОЛЬЗОВАТЕЛЯ

Private Sub login_BeforeUpdate(Cancel As Integer)

    Dim conn As Object

    Dim rs As Object

    Dim strSQL As String

    Dim НовыйЛогин As String

    НовыйЛогин = Replace(Nz(Me.login.Value, ""), "'", "''")

    If Trim(НовыйЛогин) = "" Then Exit Sub

    Set conn = CreateObject("ADODB.Connection")

conn.Open "Provider=SQLOLEDB;Data Source=DO_ZAVRTA\MS;Initial Catalog=HotelSystem;Integrated Security=SSPI;"

    strSQL = "SELECT login FROM [users] WHERE login = '" & НовыйЛогин & "'"

    Set rs = CreateObject("ADODB.Recordset")

rs.Open strSQL, conn, 1, 1

    If Not rs.EOF Then

        MsgBox "Пользователь с таким логином уже существует. Введите другой логин.", vbExclamation

        Cancel = True

        Me.login.Undo

    End If

    rs.Close: conn.Close

    Set rs = Nothing: Set conn = Nothing

End Sub

Private Sub is_blocked_BeforeUpdate(Cancel As Integer)

    If Me.is_blocked = False Then

        Me.last_auth_date = Date

        Me.login_attempts = 0

    End If

End Sub

ГЛОБАЛЬНЫЙ МОДУЛЬ

Public ТекущийЛогин As String

САМОЕ ГЛАВНОЕ

    strConn = "Provider=SQLOLEDB;Data Source=ИМЯ_СЕРВЕРА;Initial Catalog=ИМЯ_БД;Integrated Security=SSPI;"

Не  забывайте менять в этой строчке имя сервера и название вашей базы