#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 26
Default LoginID

How do I, from within VBA, determine the network user ID of the person using
the workbook.

I assume this will be some form of Windows API call, but does anyone have
any syntax for this.

Many thanks.


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default LoginID

environ("Username")

or using API:

From Google Search:
http://groups.google.com/advanced_group_search
=========
From: Trevor Shuttleworth )
Subject: 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 )
Subject: 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/index.php?t=envbaos
or Chris Rae's page http://www.chrisrae.com/vba/routines.html

Best wishes Harald


============

From: Nick Clarke )
Subject: 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/?id=161394
VBA: Sample Code to Retrieve the Current User Name [xl97]

http://support.microsoft.com/?id=152970
XL7: Visual Basic Procedure To Get Current User Name

==========
Here is one that does quite a bit mo

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


"Paul Smith" wrote in message
...
How do I, from within VBA, determine the network user ID of the person

using
the workbook.

I assume this will be some form of Windows API call, but does anyone have
any syntax for this.

Many thanks.




Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On



All times are GMT +1. The time now is 06:52 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"