Исходный текст

Option Explicit
Call CheckCurrentUserInfo()


'==============================================================================
' Проверить индекс текущего пользователя приложения, проверить наличие тестового пользователя, создать тестового пользователя
'==============================================================================
Sub CheckCurrentUserInfo()
        
        Dim  AllUsers, user, testdesc, i
        'Если нет информации о пользователях, выйти из процедуры
        If ThisApplication.Users.Count = 0 Then 
                MsgBox "Пользователи в системе отсутствуют.", _
                        vbInformation, "Информация о текущей настройке"
                Exit Sub
        End If

        
        Set AllUsers = ThisApplication.Users ' Получить коллекцию пользователей
        With AllUsers
            user = .Current
            testdesc = "Тестовый пользователь"
            Msgbox ("Номер текущего пользователя - " & AllUsers.Index(user))
            For i = 0 to .Count - 1
                    if .Item(i).Description = testdesc Then
                        MsgBox ("Имя тестового пользователя - " & .Item(i).FirstName & " " & .Item(i).LastName)
                    End If
            Next
            
        ' Создать тестового пользователя
            Dim nUser as New TDMSUser
            nUser.Description = testdesc
            .Add nUser
            
        End With
        
        
End Sub 
'==============================================================================