Re: Getting Windows user (Account) from a VBA routine

[Chip Pearson]

Jacques,

You can get the user's logon name with the following code:

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

Sub AAA()
Dim UName As String * 255
Dim L As Long: L = 255
Dim Res As Long
Res = GetUserName(UName, L)
UName = Left$(UName, L - 1)
Msgbox UName
End Sub

--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

"Jacques Brun" <anon...@discussions.microsoft.com> wrote in
message
news:4BBA65B1-65D3-4AA7...@microsoft.com...
> 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.
> Does anybody knows a solution ? Thanks

[Tom Ogilvy]

From Google Search:
http://groups.google.com/advanced_group_search
=========
From: Trevor Shuttleworth (tre...@shucks.demon.co.uk)
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 (harald...@eunet.no)
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 (nick....@ingrammicro.co.uk)
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

[Bob Phillips]

Here's a simple little function to get it

Public Declare Function GetUserName Lib "advapi32.dll" _

Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long

Public Function UserName() As String
Dim sName As String * 256
Dim cChars As Long
cChars = 256
If GetUserName(sName, cChars) Then
UserName = Left$(sName, cChars - 1)
End If
End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

[Michel Pierron]

Hi Jacques;
Sub UserInfo()
With CreateObject("WScript.NetWork")
MsgBox "User Name: " & vbTab & .UserName & vbLf _
& "Computer Name: " & vbTab & .ComputerName & vbLf _
& "Domain Name: " & .UserDomain
End With
End Sub

MP

"Jacques Brun" <anon...@discussions.microsoft.com> a écrit dans le message
de news:4BBA65B1-65D3-4AA7...@microsoft.com...

[Jacques]

Thanks Chip
it is very helpful and it works. I first went to your site which is one of my favorite sources of information on Excel. You've been helping me many times and once again today. Thanks for your very appreciated support.

[Tila]

Hai,
how can i do to get the Comment and User's comment with user name please can you help me ?

Tila

[Rob van Gelder]

MsgBox ActiveCell.Comment.Author
MsgBox ActiveCell.Comment.Text

--
Rob van Gelder - http://www.vangelder.co.nz/excel

"Tila" <Ti...@discussions.microsoft.com> wrote in message
news:500FA6EB-EFD3-43CD...@microsoft.com...