T B
asked on
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.
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.
can you please post the code you are using for each?
ASKER
1- Code for Domain Name :
2- Code For User 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
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
What code?
ASKER
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 *********
Set objNetwork = CreateObject("Wscript.Network")
Wscript.Echo "The current user is " & objNetwork.UserName
WScript.Echo "The Computer Name is:" & objNetwork.ComputerName
Manually step through this function using the F8 key and see it the message boxes are returning the expected results.
ET
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
ET
ASKER
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.
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.
ASKER
Can we remove the msg box from the function? in order to be used in the form or query?
Add this code after you check for M/S Office Version.
ET
'Check for Domain Name
Dim strUserDomain As String
strUserDomain = Environ("UserDomain")
MsgBox strUserDomain
ET
>>>>>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
Yes, you can restructure the code to fit your specific needs. You can also make each check a separate function if need be.
ET
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
Do a Google search on Environ() and review this methods for various options.
ET
ASKER
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.
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.
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
Also ... you can store the results in variables instead of a message box.
ET
ASKER
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Dear ET
Thanks a millions for your swift reply, solution and supports.
Best regards.
Thanks a millions for your swift reply, solution and supports.
Best regards.
ASKER
Thanks a millions for the superior Support and Cooperation.
Glad to help and thanks for the points.
ET
ET