Sub gsExportUsers2XLS()

'Открыть приложение Excel
Set ExcelApp = CreateObject("Excel.Application")
If Err <> 0 Then 'Ошибка открытия ...
MsgBox "Невозможно открыть приложение MS Excel.", vbInformation, "Ошибка MS Excel"
Exit Sub
End If

' Добавить рабочую книгу
Set WrkBook = ExcelApp.Workbooks.Add
Set List = WrkBook.ActiveSheet

'Отформатировать шапку таблицы
List.Cells(1,1) = "ФИО"
List.Cells(1,2) = "Отдел"
List.Cells(1,3) = "Должность"
List.Cells(1,4) = "Профиль"
List.Rows(1).Font.Size = 12
List.Rows(1).Font.Bold = TRUE

Dim mUser, mAllUsers,i
Set mAllUsers = ThisApplication.Users
i=2
for each mUser in mAllUsers
List.Cells(i+1,1) = mUser.Description
List.Cells(i+1,2) = mUser.Department
List.Cells(i+1,3) = mUser.Position
List.Cells(i+1,4) = mUser.Profile.Description
i=i+1
next
List.Columns.AutoFit

'Показать окно Excel
ExcelApp.Application.Visible = True

'Обнулить объектные переменные
Set List = Nothing
Set WrkBook = Nothing
Set ExcelApp = Nothing

End Sub