Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Finding domain and username of logged on user

32 views
Skip to first unread message

Tom

unread,
Apr 10, 2002, 9:46:51 PM4/10/02
to
Hello All,

Any body know of a way to retrieve both the domain and username of the
current logged on user from Excel VBA 97? I was hoping to get it in
the format:

DomainServer/Username

Thanks,
Tom

Ray at home

unread,
Apr 10, 2002, 10:01:10 PM4/10/02
to
Hi Tom,

Try this. Copy and paste between the ----'s and run the Test() sub. (Watch
for line wrapping.)

From http://www.vbcode.com/asp/showsn.asp?theID=3795

------------------------------------------------------------------------
Sub Test()
msgbox getlogondomainuser
End Sub


Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal
lpBuffer As String, nSize As Long) As Long
Declare Function LookupAccountName Lib "advapi32.dll" Alias
"LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String,
sid As Any, cbSid As Long, ByVal ReferencedDomainName As String,
cbReferencedDomainName As Long, peUse As Long) As Long


Public Function GetLogonDomainuser() As String
Dim lResult As Long ' Result of various API calls.
Dim I As Integer ' Used in looping.
Dim bUserSid(255) As Byte ' This will contain your SID.
Dim sUserName As String

Dim sDomainName As String * 255 ' Domain the user belongs to.
Dim lDomainNameLength As Long ' Length of domain name needed.

Dim lSIDType As Long ' The type of SID info we are
' getting back.

' Get the SID of the user. (Refer to the MSDN for more information on
SIDs
' and their function/purpose in the operating system.) Get the SID of
this
' user by using the LookupAccountName API. In order to use the SID
' of the current user account, call the LookupAccountName API
' twice. The first time is to get the required sizes of the SID
' and the DomainName string. The second call is to actually get
' the desired information.
sUserName = GetLogonUser
lResult = LookupAccountName(vbNullString, sUserName, _
bUserSid(0), 255, sDomainName, lDomainNameLength, _
lSIDType)

' Now set the sDomainName string buffer to its proper size before
' calling the API again.
sDomainName = Space(lDomainNameLength)
' Call the LookupAccountName again to get the actual SID for user.
lResult = LookupAccountName(vbNullString, sUserName, _
bUserSid(0), 255, sDomainName, lDomainNameLength, _
lSIDType)

' Return value of zero means the call to LookupAccountName failed;
' test for this before you continue.
If (lResult = 0) Then
MsgBox "Error: Unable to Lookup the Current User Account: " _
& sUserName
Exit Function
End If
sDomainName = Left$(sDomainName, InStr(sDomainName, Chr$(0)) - 1)
GetLogonDomainuser = Trim(sDomainName) & "\" & sUserName

End Function
Private Function GetLogonUser() As String
Dim strTemp As String, strUserName As String
'Create a buffer
strTemp = String(100, Chr$(0))
'strip the rest of the buffer
strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)

'Create a buffer
strUserName = String(100, Chr$(0))
'Get the username
GetUserName strUserName, 100
'strip the rest of the buffer
strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
GetLogonUser = strUserName
End Function


------------------------------------------------------------------------

Ray at home


"Tom" <rbal...@yahoo.com> wrote in message
news:4136770a.02041...@posting.google.com...

Tim Childs

unread,
Apr 11, 2002, 4:48:53 AM4/11/02
to
Tom

I have been doing something similar to this and some of the API calls are
dependent on the OS but hopefully you'll be OK

Regards

Tim


Tom

unread,
Apr 11, 2002, 2:13:09 PM4/11/02
to
"Tim Childs" <tsn...@yahoo.co.uk> wrote in message news:<O#wyJWT4BHA.2684@tkmsftngp07>...

Thanks Ray and Tim. That was exactly what I was looking for.

0 new messages