Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|