Code not working on Citrix

[MUKESHY12390]

Hi All,

I have this code which works fine on "Local system Excel" but when I run same code with Citrix Excel ( open excel through Citrix App) it doesn't work, at end I get "Out of Memory"

anyone knows why this happen.????

Option Explicit
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
Public p_lngHwnd As Variant
Public p_lngRtn As Variant
Public p_lngErr As Variant
Public system As Variant


Function Check_If_Locked() As String
'    Dim p_lngHwnd As Long
'    Dim p_lngRtn As Long
'    Dim p_lngErr As Long
'    Dim system As String
    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
    If p_lngHwnd = 0 Then
        system = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        p_lngErr = Err.LastDllError


        If p_lngRtn = 0 Then
            If p_lngErr = 0 Then
                system = "Away"
            Else
                system = "Error"
            End If
        Else
            system = "Unlocked"
        End If
        p_lngHwnd = CloseDesktop(p_lngHwnd)
    End If
    Check_If_Locked = system
End Function


Private Sub Form_Timer()
Dim i As Long


For i = 1 To 5
   Sheet1.Cells(i, 1) = Check_If_Locked
Next i


End Sub

 

[HackSlash]

Q1: What version of Excel is running on the Citrix host?

If it is using an older version then it might have a smaller memory allocation than your local version.

Q2: Are you able to see the condition of the Citrix Host system? Is it actually running out of memory?

If it is not actually running out of memory and the memory limit of excel has not been reached then you might be seeing a rare error. There are cases where an error will cause Excel to report that it is out of memory when it is not. This is the last thing we will check for after you have answered the first two questions.

Read this article "Excel specifications and limits":
https://support.office.com/en-us/ar...d-limits-1672b34d-7043-467e-8e27-269d656771c3

 

[MUKESHY12390]

thanks for quick reply!

Q1 : MS Excel 2010/14.0 both Excel (local and citrix)
Q2 :Are you able to see the condition of the Citrix Host system? I'm not sure about this

the file which I use has only above peace of code that's it. no other things

Out of Memory comes - when macro execute "End Sub" line.

 

[HackSlash]

Strange. Your code is pretty simple. The one thing I would change is those public variants. I can see that they used to be declared properly within the function "Check_If_Locked". I would switch it back. That would save you a little memory.

Does it run like this?

Option Explicit
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
'Public p_lngHwnd As Variant
'Public p_lngRtn As Variant
'Public p_lngErr As Variant
'Public system As Variant

Function Check_If_Locked() As String
    Dim p_lngHwnd As Long
    Dim p_lngRtn As Long
    Dim p_lngErr As Long
    Dim system As String
    
    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
    If p_lngHwnd = 0 Then
        system = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        p_lngErr = Err.LastDllError


        If p_lngRtn = 0 Then
            If p_lngErr = 0 Then
                system = "Away"
            Else
                system = "Error"
            End If
        Else
            system = "Unlocked"
        End If
        p_lngHwnd = CloseDesktop(p_lngHwnd)
    End If
    Check_If_Locked = system
End Function

Private Sub Form_Timer()
Dim i As Long
    For i = 1 To 5
        Sheet1.Cells(i, 1) = Check_If_Locked
    Next i
End Sub

The next thing I would do is check or updates. Follow this guide:

https://support.office.com/en-us/ar...46de917611c5?ui=en-US&rs=en-US&ad=US&fromAR=1

 

[HackSlash]

Upon closer inspection I added an error handler on your close function. This will attempt to close the handle for 30 seconds if it did not close. This will catch if you are leaving a handle open before moving on to the next attempt:

It does run on my computer.

Option Explicit
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
'Public p_lngHwnd As Variant
'Public p_lngRtn As Variant
'Public p_lngErr As Variant
'Public system As Variant

Function Check_If_Locked() As String
    Dim p_lngHwnd As Long
    Dim p_lngRtn As Long
    Dim p_lngErr As Long
    Dim system As String
    
    p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
    If p_lngHwnd = 0 Then
        system = "Error"
    Else
        p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
        
        If p_lngRtn = 0 Then
            p_lngErr = Err.LastDllError
            If p_lngErr = 0 Then
                system = "Away"
            Else
                system = "Error"
            End If
        Else
            system = "Unlocked"
        End If
        p_lngHwnd = CloseDesktop(p_lngHwnd)
        
        If p_lngHwnd = 0 Then
            p_lngErr = Err.LastDllError
            MsgBox "Failed to release Desktop handle" & vbNewLine & p_lngErr, vbCritical, "ERROR"
            
            Dim waitTill As Date
            waitTill = Now() + TimeValue("00:30:00")
            While p_lngHwnd = 0
                DoEvents
                p_lngHwnd = CloseDesktop(p_lngHwnd)
                If Now() > waitTill Then p_lngHwnd = 54 'Timeout error and end the loop
            Wend
        End If
    End If
    Check_If_Locked = system
    
End Function

Private Sub Form_Timer()
Dim i As Long
    For i = 1 To 5
        Sheet1.Cells(i, 1) = Check_If_Locked
    Next i
End Sub

 

[MUKESHY12390]

thanks for reply,

still having same problem code works when I use local system's Excel or Access but on citrix it shows only "Unlocked" in it doesn't matter if system is locked.

any other suggestion.