Get Current user's Workstation name logged into Host computer

Question

I have a host machine running windows-7 and users from the home network login using windows remote desktop connection and run some applications , I can visually see the log of who logged in under

Event Viewer->Windows Logs->Security->Audit Success->Details->Workstation name

Since only one connection is allowed using Remote Desktop connection, I want to display in an access database who the current user is, from the audit trail so users know if anyone is currently using the Host machine

So basically a VBA code to grab the most recent workstation that logged in, specially I am interested in Event ID-4624

I am open for other suggestions!

what I have tried so far?

Function Reachable(strComputer) As String  'Test Connectivty to computer
'On Error Resume Next
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objSWbemLocator.ConnectServer(strComputer, "root\cimv2", "username", "password")

Set colItems = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkLoginProfile")

For Each objItem In colItems
    Reachable = "Full Name: " & objItem.FullName

Next
End Function

Answer 1

Would this work?

Dim sHostName As String

sHostName = Environ$("computername")

Answer 2

What about Environ("clientname")? At least in the RDP setup I use, it is an environment variable that names my PC that has connected to the remote desktop host computer.

Answer 3

I found a solution here:

https://kbase.icbconsulting.com/vba/get-rdp-client-workstation

GetClientName() will return the Name of the RDP Client.

' VBA Code to get the name of the workstation of the current Remote Desktop user
'Link to MSDN documentation for this windows api
'#WTSQuerySessionInformation (Windows) http://msdn2.microsoft.com/en-us/library/aa383838.aspx

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Long)
Private Declare Function WTSQuerySessionInformation Lib "wtsapi32.dll" Alias "WTSQuerySessionInformationW" _
    (ByVal hServer As Long, ByVal sessionId As Long, ByVal wtsInfoClass As Long, ByRef pBuffer As Long, ByRef dwSize As Long) As Long

Public Function GetClientName() As String

    Dim pBuffer As Long
    Dim dwSize As Long

    If WTSQuerySessionInformation(0, -1, 10, pBuffer, dwSize) Then
        Dim clientName As String
        clientName = String(dwSize, 0)
        CopyMemory ByVal StrPtr(clientName), ByVal pBuffer, dwSize
        WTSFreeMemory pBuffer
        GetClientName = clientName
    End If

End Function