Получение полного имени пользователя 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
'================================================================