VBA, MS Access MS Access в примерах

Определение имени пользователя Windows (API)

#If VBA7 Then 'For 64-bit office installation
    Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" _
        Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long
#Else 'For 32-bit office installation
    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
'es - 14.10.2021 - v001 - Возвращает имя пользователя Windows
'-----------------------------------------------------------------------------------
'?GetUserWindowsName
'-----------------------------------------------------------------------------------
#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, "Произошла ошибка!"
    'Debug.Print "GetUserWindowsName_Line: " & Erl & "."
    Err.Clear
    Resume GetUserWindowsName_End
End Function


Назад ToTop
L.E. 15.10.2021
Рейтинг@Mail.ru