PDA

View Full Version : determining user domain account (AD) from VBA



STL928
05-21-2008, 01:14 PM
Hello All,
I am writing a simple VBA application (the code lives in .xls file). To open my .xls file, I run Excel using "Run As..." option. Is there any way to programmatically determine from VBA who the user is (domain\account) that is currently opening this file?

This is done in Windows server 2003 environment, with Active Directory.

If there is a solution to this problem, will the same work for XP or Vista?

STL928
05-21-2008, 02:31 PM
There is environ"USERNAME" function, but that seems to only return user name, without the domain name...
Anybody knows how to get domain name, without calling win api, or .NET classes?

Bob Phillips
05-21-2008, 02:36 PM
Here is a routine I half-inched from Randy Birch some years ago



Option Explicit

Private Declare Function LookupAccountName Lib "advapi32" Alias "LookupAccountNameA" ( _
ByVal lpSystemName As String, _
ByVal lpAccountName As String, _
Sid As Byte, _
cbSid As Long, _
ByVal DomainName As String, _
cbDomainName As Long, _
peUse As Long) As Long


Public Sub TestIt()
Dim Account As String 'account name of interest
Dim System As String 'specifying the system
Dim Domain As String 'domain validating user
Dim Details As String

Account = Environ("Username")
System = ""
Domain = ""

Select Case ValidateUser(Account, Domain, System)
Case True: Details = Account & " - " & Domain
Case False: Details = "User not found."
End Select

MsgBox Details

End Sub


Public Function ValidateUser(Optional ByRef AccountName As String, _
Optional ByRef DomainName As String, _
Optional ByVal SystemName As String) As Boolean
Dim success As Long
Dim cbSid As Long
Dim cbDomainName As Long
Dim peUse As Long
Dim bSID() As Byte

If AccountName = "" Then AccountName = Environ("Username")
DomainName = vbNullString
cbDomainName = 0

If Len(SystemName) = 0 Then SystemName = vbNullString
success = LookupAccountName(SystemName, AccountName, 0&, cbSid, DomainName, cbDomainName, peUse)
If (success = 0) And (cbSid > 0) Then

DomainName = Space$(cbDomainName)
ReDim bSID(0 To cbSid - 1)
success = LookupAccountName(SystemName, AccountName, bSID(0), cbSid, DomainName, cbDomainName, peUse)
If success > 0 Then

If cbDomainName > 0 Then DomainName = Left$(DomainName, cbDomainName)
End If
End If

ValidateUser = success

End Function