Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function LoginUserName() As String 'Имя активного локального пользователя
Dim sBuffer As String
Dim lSize As Long, int1 As Long
Dim retUserName As String


On Error GoTo Err_LoginUserName

sBuffer = Space$( 255 )
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize >  0  Then
int1 = InStr( 1 , sBuffer, Chr( 0 ), vbTextCompare)
retUserName = Left$(sBuffer, int1 -  1 )
Else
retUserName = ""
End If

Exit_LoginUserName:
LoginUserName = retUserName
Exit Function

Err_LoginUserName:
Debug.Print Err.Description
retUserName = ""
Resume Exit_LoginUserName

End Function