MyTetra Share
Делитесь знаниями!
Определить имя пользователя
Время создания: 28.05.2020 11:20
Текстовые метки: GetVersion UserName, UserName, Имя пользователя, Environ
Раздел: Разные закладки - VBA
Запись: xintrea/mytetra_db_adgaver_new/master/base/15139414504dngkp6onb/text.html на raw.githubusercontent.com

Получение полного имени пользователя Windows макросом VBA

Чтобы получить полное имя пользователя в Windows, можно использовать функцию UserFullName:

Sub ПримерИспользованияUserFullName()

ПолноеИмяПользователяWindows = WMI_UserFullName

MsgBox ПолноеИмяПользователяWindows

End Sub

Данная функция использует интерфейс WMI для получения необходимых данных.

Function WMI_UserFullName() As String

login$ = CreateObject("WScript.Network").UserName ' читаем логин текущего пользователя


Set objWMIService = GetObject("winmgmts://./root/CIMV2")

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount", , 48)

For Each objItem In colItems ' перебираем все учётные записи

If objItem.Name = login$ Then WMI_UserFullName = objItem.FullName

Next

End Function

Посмотреть список всех учётных записей пользователей на компьютере можно следующим кодом:

Sub WMI_username()

Set objWMIService = GetObject("winmgmts://./root/CIMV2")

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount", , 48)

For Each objItem In colItems

Debug.Print "FullName: " & objItem.FullName

Next

End Sub

Результат работы этого кода:

FullName: ASP.NET Machine Account
FullName: Учетная запись помощника для удаленного рабочего стола
FullName: CN=Microsoft Corporation,L=Redmond,S=Washington, C=US
FullName:
FullName: VBA Developer

 

Если же вам нужно получить только логин (имя пользователя) Windows, то код будет заметно проще:
(все 3 способа равнозначны - возвращают один и тот же результат)

Sub ПолучениеИмениПользователяWindows()

 

' первый способ (читаем из переменной окружения)

username1 = Environ("USERNAME")

Debug.Print "username 1: " & username1

 

' второй способ (используем объект WScript.Network)

username2 = CreateObject("WScript.Network").UserName

Debug.Print "username 2: " & username2

 

' третий способ (читаем значение из реестра Windows)

key$ = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOwner"

username3 = CreateObject("WScript.Shell").RegRead(key$) ' читаем из реестра

Debug.Print "username 3: " & username3

 

End Sub

 

PS




'\\ ==============================================================

'Имя пользователя (разрешения по пользователям)

'Sub testFnGetUserName()

'ff = FnGetUserName()

'End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function FnGetUserName() As Boolean

Dim strUserName As String

strUserName = VBA.Environ("UserName")

Select Case strUserName

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case "username": FnGetUserName = True

Case Else: FnGetUserName = False

End Select

End Function


'================================================================

Sub GetUserDate()

Dim msg As String

msg = "Пользователь: " & Environ("UserName") & Chr(13) _

& "Текущая дата и время: " & Now

'Environ("UserName") возвращает имя текущего пользователя

' Now - возвращает дату и время ПК

MsgBox msg

End Sub


'================================================================

Sub MainSMS()

Dim strUser As String

Dim blnUser As Boolean


ThisDocument.Refresh

FnExport 'экспорт файлов


strUser = Environ("UserName")

Select Case strUser

Case "username": blnUser = True

Case "username": blnUser = True

Case "username": blnUser = True

Case "username": blnUser = True

End Select

If Not blnUser Then

strSMS = FnTextSMS 'текст смс

Param 'адресаты

m = Split(strSMS, " | ", -1, vbTextCompare)

СМС = FnSendSMS(tnum, m(LBound(m))) 'отправка смс DPU

СМС = FnSendSMS(tnumN, m(UBound(m))) 'отправка смс Non STR

Почта = FhSendMail

ThisDocument.Save

Application.Quit

End If

End Sub

'================================================================

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования