|
|
Определение имени пользователя Windows (API)
#If VBA7 Then
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long
#Else
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If
Public Function GetUserWindowsName() As String
#If VBA7 Then
Dim BufSize As LongPtr
#Else
Dim BufSize As Long
#End If
Dim strUserName As String * 255, lStatus As Long
On Error GoTo GetUserWindowsName_Err
BufSize = 255
lStatus = apiGetUserName(strUserName, BufSize)
If lStatus = 1 Then
GetUserWindowsName = Left$(strUserName, InStr(strUserName, Chr(0)) - 1)
Else
GetUserWindowsName = ""
End If
GetUserWindowsName_End:
Exit Function
GetUserWindowsName_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function" & _
"GetUserWindowsName - 00_Tests.", vbCritical, "Произошла ошибка!"
Err.Clear
Resume GetUserWindowsName_End
End Function
|
|