VBA MS Access log users

Ведение логов посещения приложения в MS Access через VBA

Необходимо создать две таблицы - Пользователи и Журнал

'Модуль функций
Option Compare Database 'сортировка символов определяется базой данных
Option Explicit 'запретить не объявленные переменные

'внешняя функция определения логина текущего пользователя компьютера
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'внешняя функция определения имени текущего компьютера
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'функция определения логина текущего пользователя компьютера
Function ТекущийПользователь() As String
Dim Результат As Long 'код возврата внешней функции
Dim ДлинаИмени 'длина имени пользователя
Dim ИмяПользователя As String 'имя пользователя
    ИмяПользователя = String(254, 0) 'заполняем строку имени пользователя нулями
    ДлинаИмени = 255 'устанавливаем начальную длину имени
    Результат = apiGetUserName(ИмяПользователя, ДлинаИмени) 'запрашиваем значение
    If Результат <> 0 Then
        ТекущийПользователь = Left(ИмяПользователя, ДлинаИмени - 1)
    Else
        ТекущийПользователь = ""
    End If
End Function

'функция определения имени текущего компьютера
Function ТекущийКомпьютер() As String
Dim Результат As Long 'код возврата внешней функции
Dim ДлинаИмени 'длина имени пользователя
Dim ИмяКомпьютера As String 'имя пользователя
    ДлинаИмени = 16
    ИмяКомпьютера = String(ДлинаИмени, 0)
    Результат = apiGetComputerName(ИмяКомпьютера, ДлинаИмени)
    If Результат <> 0 Then
        ТекущийКомпьютер = Left(ИмяКомпьютера, ДлинаИмени)
    Else
        ТекущийКомпьютер = ""
    End If
End Function

Private Sub Form_Open(Cancel As Integer)

Dim RS As Recordset

    Set RS = CurrentDb.OpenRecordset("Журнал", dbOpenTable)

    RS.Index = "PrimaryKey"

    RS.Seek "=", ТекущийПользователь(), ТекущийКомпьютер()

    If RS.NoMatch Then

        RS.AddNew

        RS!Пользователь = ТекущийПользователь()

        RS!Компьютер = ТекущийКомпьютер()

        RS!Вход = Now()

        RS!Выход = Null

        RS!Счётчик = 1

        RS.Update

    Else

        RS.Edit

        RS!Вход = Now()

        RS!Выход = Null

        RS!Счётчик = RS!Счётчик + 1

        RS.Update

    End If

    Set RS = Nothing

End Sub

Private Sub Form_Close()

Dim RS As Recordset

    Set RS = CurrentDb.OpenRecordset("Журнал", dbOpenTable)

    RS.Index = "PrimaryKey"

    RS.Seek "=", ТекущийПользователь(), ТекущийКомпьютер()

    If RS.NoMatch Then

        RS.AddNew

        RS!Пользователь = ТекущийПользователь()

        RS!Компьютер = ТекущийКомпьютер()

        RS!Вход = Null

        RS!Выход = Now()

        RS!Счётчик = 1

        RS.Update

    Else

        RS.Edit

        RS!Выход = Now()

        RS.Update

    End If

    Set RS = Nothing

End Sub