Based on Helge Klein's revised answer (above) I thought I'd post the VBA code to make this happen to help future VBA users hitting this page. Helge already has the C++ code on his own site. If you find this helpful, please upvote Helge Klein's answer.
Option Explicit
Private Const WTS_CURRENT_SERVER_HANDLE = 0&
Private Const WTS_CURRENT_SESSION As Long = -1
Private Enum WTS_INFO_CLASS
WTSInitialProgram
WTSApplicationName
WTSWorkingDirectory
WTSOEMId
WTSSessionId
WTSUserName
WTSWinStationName
WTSDomainName
WTSConnectState
WTSClientBuildNumber
WTSClientName
WTSClientDirectory
WTSClientProductId
WTSClientHardwareId
WTSClientAddress
WTSClientDisplay
WTSClientProtocolType
WTSIdleTime
WTSLogonTime
WTSIncomingBytes
WTSOutgoingBytes
WTSIncomingFrames
WTSOutgoingFrames
WTSClientInfo
WTSSessionInfo
WTSSessionInfoEx
WTSConfigInfo
WTSValidationInfo
WTSSessionAddressV4
WTSIsRemoteSession
End Enum
Private Declare Function WTSQuerySessionInformation _
Lib "wtsapi32.dll" Alias "WTSQuerySessionInformationA" ( _
ByVal hServer As Long, ByVal SessionId As Long, _
ByVal WtsInfoClass As WTS_INFO_CLASS, _
ByRef ppBuffer As LongPtr, _
ByRef pBytesReturned As LongPtr _
) As Long
Private Declare Function WFGetActiveProtocol _
Lib "wfapi.dll" ( _
ByVal SessionId As Long _
) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" ( _
ByVal pMemory As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal length As Long)
Public Function SessionType() As String
Dim ResultCode As Long
Dim p As LongPtr
Dim ppBuffer As LongPtr
Dim pBytesReturned As Long
Dim ClientProtocolType As Integer
ResultCode = WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientProtocolType, ppBuffer, pBytesReturned)
If ResultCode = 0 Then
p = ppBuffer
CopyMemory ClientProtocolType, ByVal p, pBytesReturned
WTSFreeMemory ppBuffer
End If
Select Case ClientProtocolType
Case 0:
On Error Resume Next
ResultCode = WFGetActiveProtocol(WTS_CURRENT_SESSION)
If Err.Number = 53 Then
SessionType = "Console"
ElseIf Err.Number = 0 Then
If ResultCode = 1 Then
SessionType = "Citrix"
Else
SessionType = "Console"
End If
End If
Err.Clear
On Error GoTo 0
Case 1:
SessionType = "Citrix"
Case 2:
SessionType = "RDP"
Case Else
SessionType = "Other (" & ClientProtocolType & ")"
End Select
End Function
I've tested this on XenApp and XenDesktop.
WFQuerySessionInformation
in theirWFAPI SDK
for example citrix.com/content/dam/citrix/en_us/documents/downloads/sdk/… – Illuminati