Ms access User Name, Domain Name and Workstation Name

Dear Experts

I use to use a module to get the user name, Domain Name and Workstation name, the code is working perfect if using windows 7 with MS OFFice 2007-2010. Unfortunatly with windows (i.e. 8 and 8.1 - 64 or 32 BIT) and MS OFFICe (i.e. 2013) the code is not working.

As I have no control in the installed operating systems and\or MS OFFICE versions at end users machine, Could you please help me to have sort of code that could accommodate the following :

Windows Version
Windows 7
Windows 8
Windows 8.1

System Type
64-Bit and 32-Bit

MS Office Version
2007
2010
2013

Thanks and regards.
TAB-000Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jeffrey CoachmanMIS LiasonCommented:
can you please post the code you are using for each?
0
TAB-000Author Commented:
1- Code for Domain Name :

Option Compare Database
Option Explicit

Private Type WKSTA_USER_INFO_1
   wkui1_username As Long     'name of the user _
                              currently logged on _
                              to the workstation.
   wkui1_logon_domain As Long 'the domain name of _
                              the user account of the _
                              user currently logged on
   wkui1_oth_domains As Long  'list of other LAN _
                              Manager domains browsed _
                              by the workstation.
   wkui1_logon_server As Long 'name of the computer _
                              that authenticated the _
                              server
End Type

Private Declare Function apiWkStationUser Lib "Netapi32" _
  Alias "NetWkstaUserGetInfo" _
  (ByVal Reserved As Long, _
  ByVal level As Long, _
  bufptr As Long) _
  As Long
  
Private Declare Function apiStrLenFromPtr Lib "kernel32" _
  Alias "lstrlenW" _
  (ByVal lpString As Long) _
  As Long

Private Declare Sub sapiCopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" _
  (hpvDest As Any, _
  hpvSource As Any, _
  ByVal cbCopy As Long)


Public Function fUserNTDomain() As String

On Error GoTo ErrHandler
  Dim lngRet As Long
  Dim lngPtr As Long
  Dim tNTInfo As WKSTA_USER_INFO_1
  
  lngRet = apiWkStationUser(0&, 1&, lngPtr)
  If lngRet = 0 Then
    Call sapiCopyMemory(tNTInfo, ByVal lngPtr, LenB(tNTInfo))
    If Not lngPtr = 0 Then
      With tNTInfo
        fUserNTDomain = fStringFromPtr(.wkui1_logon_domain)
      End With
    End If
  End If

ExitHere:
  Exit Function
ErrHandler:
  fUserNTDomain = vbNullString
  Resume ExitHere
End Function

Private Function fStringFromPtr(lngPtr As Long) As String
Dim lngLen As Long
Dim abytStr() As Byte
  lngLen = apiStrLenFromPtr(lngPtr) * 2
  If lngLen > 0 Then
    ReDim abytStr(0 To lngLen - 1)
    Call sapiCopyMemory(abytStr(0), ByVal lngPtr, lngLen)
    fStringFromPtr = abytStr()
  End If
End Function

Open in new window



2- Code For User Name :

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

Function GetLogonName() As String
 
 ' Dimension variables
 Dim lpBuff As String * 255
 Dim ret As Long
 
 ' Get the user name minus any trailing spaces found in the name.
 ret = GetUserName(lpBuff, 255)
 
 If ret > 0 Then
 GetLogonName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
 Else
 GetLogonName = vbNullString
 End If
 
End Function

Open in new window

0
David Johnson, CD, MVPOwnerCommented:
What code?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

TAB-000Author Commented:
3- Domain Name and Full Name

Option Compare Database

' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type
 
Private Declare Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
 
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
 
' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    username As Any, _
    ByVal level As Long, _
    bufptr As Long) As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Private Declare Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
 
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&
 
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
 
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Private Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function
' ******** Code End *********

Open in new window

0
David Johnson, CD, MVPOwnerCommented:
Set objNetwork = CreateObject("Wscript.Network")
Wscript.Echo "The current user is " & objNetwork.UserName
WScript.Echo "The Computer Name is:" & objNetwork.ComputerName

Open in new window

0
Eric ShermanAccountant/DeveloperCommented:
Manually step through this function using the F8 key and see it the message boxes are returning the expected results.

Public Function getComputerInfo()
     Dim localHost       As String
     Dim objWMIService   As Variant
     Dim colOperatingSystems As Variant
     Dim objOperatingSystem As Variant

    On Error GoTo Error_Handler

    localHost = "." 'Technically could be run against remote computers, if allowed
    
'Operating System and Version

     Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & localHost & "\root\cimv2")
     Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

    For Each objOperatingSystem In colOperatingSystems
         MsgBox objOperatingSystem.Caption & " " & objOperatingSystem.Version
     Next

'Computer Name and User Name

    Dim colComputerSystems As Variant
    Dim objComputer As Variant
    Dim COMPNAME As String
    Dim USERNAME As String
    
    Set colComputerSystems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")

    For Each objComputer In colComputerSystems
        COMPNAME = objComputer.NAME
        USERNAME = objComputer.USERNAME
        MsgBox COMPNAME & " " & USERNAME
    Next

'Check for 64 Bit

    Dim Is64bit As Boolean
    Is64bit = Len(Environ("ProgramW6432")) > 0
    If Is64bit = True Then
        MsgBox "64 Bit Operating System"
    Else
        MsgBox "32 Bit Operating System"
    End If
    
'Check for M/S Office Version
MsgBox "Office Version  " & Application.Version

    
Error_Handler_Exit:
     On Error Resume Next
     Exit Function

Error_Handler:
     MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: getOperatingSystem" & vbCrLf & _
            "Error Description: " & Err.DESCRIPTION, _
            vbCritical, "An Error has Occured!"
     Resume Error_Handler_Exit
 End Function

Open in new window



ET
0
TAB-000Author Commented:
Dear etsherman,

Having test above function in Windows 8.1 (64-Bit) with Office Version 15, and it's returning the expected results .  Soon I'll test it in another operating system.

Since the function returning the Machine name and user name Is it possible to include the domain name?

Thanks a millions etsherman.
0
TAB-000Author Commented:
Can we remove the msg box from the function? in order to be used in the form or query?
0
Eric ShermanAccountant/DeveloperCommented:
Add this code after you check for M/S Office Version.

'Check for Domain Name
    Dim strUserDomain As String
    strUserDomain = Environ("UserDomain")
    MsgBox strUserDomain

Open in new window


ET
0
Eric ShermanAccountant/DeveloperCommented:
>>>>>Can we remove the msg box from the function? in order to be used in the form or query? <<<<<

Yes, you can restructure the code to fit your specific needs.  You can also make each check a separate function if need be.  

ET
0
Eric ShermanAccountant/DeveloperCommented:
You could also use the Environ("Expression") to return various parameters about the current workstation environment.

Do a Google search on Environ() and review this methods for various options.

ET
0
TAB-000Author Commented:
Dear ET,

I've tried to make these available in the form but all in vain. I could not produce the result if the "msgbox" is removed.

I would greatly appreciate your help to accomplish it.

Best regards.
0
Eric ShermanAccountant/DeveloperCommented:
Can you load up a sample DB ... I would need to see exactly what you are trying to accomplish.

Also ... you can store the results in variables instead of a message box.

ET
0
TAB-000Author Commented:
Dear ET,

Please find attached the sample DB, as frmMain show the results.

Regards.
Database2.accdb
0
Eric ShermanAccountant/DeveloperCommented:
Ok, see below ... Replace your Module "ModComputerInfo" with the following code.  You need to make each one a separate function as shown below the set the Control Source on your form for each control accordingly.  See picture.

Public Function getOperatingSys()
     Dim localHost       As String
     Dim objWMIService   As Variant
     Dim colOperatingSystems As Variant
     Dim objOperatingSystem As Variant
     Dim strOS As String
     
    On Error GoTo Error_Handler

    localHost = "."
    
'Operating System and Version

     Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & localHost & "\root\cimv2")
     Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

    For Each objOperatingSystem In colOperatingSystems
         strOS = strOS & objOperatingSystem.Caption & " " & objOperatingSystem.Version
    Next
    
    getOperatingSys = strOS

Error_Handler_Exit:
     On Error Resume Next
     Exit Function

Error_Handler:
     MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: getOperatingSystem" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
     Resume Error_Handler_Exit
 End Function

Function getCompNameUserName()

'Computer Name and User Name

getCompNameUserName = "Computer Name = " & Environ("computername") & "  " & "User Name = " & Environ("username")

End Function

Function getProcessorType()

'Check for 64 Bit or 32 Bit
Dim Is64bit As Boolean
    Is64bit = Len(Environ("ProgramW6432")) > 0
    If Is64bit = True Then
        getProcessorType = "64 Bit Operating System"
    Else
        getProcessorType = "32 Bit Operating System"
    End If

   
End Function
    

Function getDomainName()
'Check for Domain Name

   getDomainName = Environ("UserDomain")
        
 End Function

Function getOfficeVersion()
getOfficeVersion = "Office Version  " & [Application].[Version]
End Function

Open in new window


frmMain Sample
ET
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TAB-000Author Commented:
Dear ET

Thanks a millions for your swift reply, solution and supports.

Best regards.
0
TAB-000Author Commented:
Thanks a millions for the superior Support and Cooperation.
0
Eric ShermanAccountant/DeveloperCommented:
Glad to help and thanks for the points.

ET
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.