From Google Search:
http://groups.google.com/advanced_group_search
=========
From: Trevor Shuttleworth (
[email protected])
Subject: Re: Code to show login name
Newsgroups: microsoft.public.excel.programming
Date: 2001-01-16 12:54:01 PST
Private Declare Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nsize As Long) As Long
Sub GetUserNameTest()
MsgBox fOSUserName
End Sub
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function
Regards
Trevor
============
From: Harald Staff (
[email protected])
Subject: Re: Login username
Newsgroups: microsoft.public.excel.programming
View complete thread
Date: 2000-12-18 08:34:07 PST
Allan
See mr Erlandsen's page
http://www.erlandsendata.no/english/vba/os/index.php?t=envbaos
or Chris Rae's page
http://www.chrisrae.com/vba/routines.html
Best wishes Harald
============
From: Nick Clarke (
[email protected])
Subject: Re: Capture WINDOWS NT network login user name
Newsgroups: microsoft.public.excel.programming
Date: 2000-10-27 09:07:35 PST
This isn't my code, so thanks to the original poster, but hopefully this
should help you out:
' Declaration
Private Declare Function api_GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
' Macro to get back the Network User ID
Public Function GetUser()
Dim Buff As String
Dim BuffSize As Long
Dim result As Long
BuffSize = 256
Buff = Space$(BuffSize)
result = api_GetUserName(Buff, BuffSize)
GetUser = Trim$(Buff)
End Function
========
Some KB Articles:
http://support.microsoft.com/support/kb/articles/q161/3/94.asp
VBA: Sample Code to Retrieve the Current User Name [xl97]
http://support.microsoft.com/support/kb/articles/q152/9/70.asp
XL7: Visual Basic Procedure To Get Current User Name
==========
Here is one that does quite a bit more:
Option Explicit
'
'
http://www.devx.com/gethelp/newinquiry.asp?ItemID=5199
' URL Posted by Sam Barrett,
' Microsoft.Public.Excel.Programming
' Jan 31, 2001
'
Private m_strUserName As String
Private m_strServerName As String
Private Declare Function GetUserName _
Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Function NetUserGetInfo _
Lib "netapi32" _
(ServerName As Byte, _
UserName As Byte, _
ByVal Level As Long, _
lpBuffer As Long) As Long
Private Declare Function NetGetDCName _
Lib "netapi32.dll" _
(ServerName As Byte, _
DomainName As Byte, _
Buffer As Long) As Long
Private Declare Function NetApiBufferFree _
Lib "netapi32" _
(ByVal pBuffer As Long) As Long
Private Declare Sub CopyMem _
Lib "kernel32" Alias "RtlMoveMemory" _
(pTo As Any, _
uFrom As Any, _
ByVal lSize As Long)
Private Declare Function lstrlenW _
Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function lstrlen _
Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Const constUserInfo10 As Long = 10
Private Type USER_INFO_10_API
Name As Long
Comment As Long
UserComment As Long
FullName As Long
End Type
Private Type USER_INFO_10
Name As String
Comment As String
UserComment As String
FullName As String
End Type
Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&
Private Sub GetPDC(ByVal xi_strServer As String, _
ByVal xi_strDomain As String, _
ByRef xo_strPDC_Name As String)
Dim p_strTmp As String
Dim p_lngRtn As Long
Dim p_lngBufferPtr As Long
Dim p_astrTmp(100) As Byte
Dim p_abytServerName() As Byte
Dim p_abytDomainName() As Byte
Dim p_vntReplacementStrings As Variant
' ------------------------------------------
' Move to byte array
' ------------------------------------------
p_abytServerName = xi_strServer & vbNullChar
p_abytDomainName = xi_strDomain & vbNullChar
' ------------------------------------------
' Get the name of the PDC
' ------------------------------------------
p_lngRtn = NetGetDCName(p_abytServerName(0), _
p_abytDomainName(0), _
p_lngBufferPtr)
' ------------------------------------------
' Set the return value (zero is success)
' ------------------------------------------
If p_lngRtn <> 0 Then
Exit Sub
End If
' Translate the name
If p_lngRtn = 0 Then
xo_strPDC_Name = PointerToStringW(p_lngBufferPtr)
Else
xo_strPDC_Name = ""
End If
' Free the buffer
NetApiBufferFree p_lngBufferPtr
End Sub
Public Function UserFullName() As String
Dim p_typUserInfo As USER_INFO_10
Dim p_typUserInfoAPI As USER_INFO_10_API
Dim p_lngBuffer As Long
Dim p_bytServerName() As Byte
Dim p_bytUserName() As Byte
Dim p_lngRtn As Long
' Get the server name
If Len(Trim$(m_strServerName)) = 0 Then
GetPDC "", "", m_strServerName
End If
' Convert string to a pointer
If Len(Trim$(m_strServerName)) = 0 Then
'p_lngPtrServerName = 0&
p_bytServerName = vbNullChar
Else
p_bytServerName = m_strServerName & vbNullChar
'p_lngPtrServerName = StrPtr(m_strServerName)
End If
' Make sure we have a user name
If m_strUserName = vbNullString Then
m_strUserName = Module1.UserName()
End If
' Convert the user name to a pointer
If Len(Trim$(m_strUserName)) = 0 Then
Exit Function 'Handle the error
Else
p_bytUserName = m_strUserName & vbNullChar
End If
' Get the current info
p_lngRtn = NetUserGetInfo(p_bytServerName(0), _
p_bytUserName(0), _
constUserInfo10, _
p_lngBuffer)
If p_lngRtn = NERR_Success Then
CopyMem p_typUserInfoAPI, _
ByVal p_lngBuffer, _
Len(p_typUserInfoAPI)
' Comment by Ogilvy
'[ This is for VB, but you can adapt this to Excel VBA]
p_typUserInfo.FullName = PointerToStringW(p_typUserInfoAPI.FullName)
p_typUserInfo.Comment = PointerToStringW(p_typUserInfoAPI.Comment)
p_typUserInfo.Name = PointerToStringW(p_typUserInfoAPI.Name)
p_typUserInfo.UserComment = _
PointerToStringW(p_typUserInfoAPI.UserComment)
UserFullName = p_typUserInfo.FullName
End If
If p_lngBuffer Then
Call NetApiBufferFree(p_lngBuffer)
End If
End Function
Public Function UserName() As String
Dim p_strBuffer As String
Dim p_lngBufSize As Long
Dim p_strName As String
Dim p_lngRtn As Long
' ------------------------------------------
' Retrieve the curent user's name from the
' operating system
' ------------------------------------------
p_strBuffer = Space$(255)
p_lngBufSize = Len(p_strBuffer)
p_lngRtn = GetUserName(p_strBuffer, p_lngBufSize)
' ------------------------------------------
' If failed, then just put in a blank
' Otherwise, fill in user name on the form
' ------------------------------------------
If p_lngRtn > 0 Then
m_strUserName = Left$(p_strBuffer, p_lngBufSize - 1)
Else
m_strUserName = vbNullString
End If
UserName = m_strUserName
End Function
Private Function PointerToStringW(lpStringW As Long) As String
Dim Buffer() As Byte
Dim nLen As Long
If lpStringW Then
nLen = lstrlenW(lpStringW) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMem Buffer(0), ByVal lpStringW, nLen
PointerToStringW = Buffer
End If
End If
End Function
Regards,
Tom Ogilvy
Jacques Brun said:
I want to provide an audit trail of who did what and when for a shared
Excel application. The "Application.Username"
returns an Id that can easily be forged (Tools Options etc.). I've been
looking for a way to retrieve the userid (account)
used to log on to the operating system (Windows) but so far i didn't found
anything in my documentation or on the Web.
