VBA no longer working via citrix or VMware

Danni

New Member
Joined
Feb 23, 2013
Messages
11
We have a simple macro where multiple users in multiple locations can sign off on a daily checklist. If a user signs off via citrix or VMware other users are then prevented from signing off. No error message is received, when they click the button absolutely nothing happens.

I looked at the code and got a few other to look at it and all seems fine, users not accessing the network via citrix or VMware have no issues in signing off the checklist.

The checklist was working fine of all users one day then suddenly stopped working for the citrix/vmware users the next with no change being made to the code.

Has anyone ever seen this before or have any idea what could have caused a macro that had previously been working for over a year to suddenly stop working?

Any help would be greatly appreciated!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
There are multiple command buttons each with similar code for sign off in a particular cell:

Public Sub CommandButton1_Click()
If Range("S106") <> vbNullString Then
MsgBox ("Initial-NAV Preparer has already been signed off !")
Range("C106").Select
Else
Unprtsht
Worksheets("Checklist").Range("A1:K101").Locked = True
Range("E106").Activate
Call ApplySignOff(0, 1)
Prtsht
End If

End Sub
Public Sub CommandButton2_Click()
If Range("S108") <> vbNullString Then
MsgBox ("Initial-NAV Preparer has already been signed off !")
Range("C108").Select
Else
Unprtsht
Worksheets("Checklist").Range("A1:K101").Locked = True
Range("E108").Activate
Call ApplySignOff(0, 1)
Prtsht
End If

The code to actually get the sign-off is maintained in module 1 of the macro as follows:

Const sPassword = "password"
Sub Unprtsht()
ActiveSheet.Unprotect sPassword
End Sub
Sub Prtsht()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=sPassword
End Sub
'Function will return True if the user xasn't already signed off
'sGroup - when set to 1 checks Pre-XxXX, when set to 2 check Post-XXXX
Public Function CheckUser(sUser As String, sGroup As Integer) As Boolean
Dim Rng As Range
CheckUser = False
If sGroup = 1 Then
With ActiveSheet.Range("S104:S128")
Set Rng = .Find(What:=sUser)
End With
Else
With ActiveSheet.Range("S156:S167")
Set Rng = .Find(What:=sUser)
End With
End If
If Rng Is Nothing Then CheckUser = True
End Function
Public Function ApplySignOff(iSignatureOffset, sGroup As Integer)
Dim sDisplayname As String
Dim SingleSignOffCheck As String

sDisplayname = GetDisplayName(Environ("USERNAME"))
SingleSignOffCheck = Environ("USERDOMAIN") & "\" & Environ("USERNAME")
Application.ScreenUpdating = False
If CheckUser(SingleSignOffCheck, sGroup) Then
'Unprtsht


ActiveCell.Value = sDisplayname & " (" & SingleSignOffCheck & " " & Date & ")"
ActiveCell.Offset(iSignatureOffset, 11).Value = SingleSignOffCheck

'Prtsht
Else
MsgBox "Current user has already signed off this checklist"
End If
Application.ScreenUpdating = True
End Function

Public Function GetDisplayName(sAMAccountName As Variant) As String
Dim objconn As Object
Dim objCommand As Object
Dim objRoot As Object
Dim objDomain As Object
Dim objRS As Object
Dim strDomain As String
Dim strSQL As String
Dim varSearch As Variant
On Error GoTo PROC_ERR
GetDisplayName = ""
Set objconn = CreateObject("ADODB.Connection")
objconn.Provider = "ADsDSOObject"
objconn.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objconn
Set objRoot = GetObject("ldap://rootDSE")
strDomain = objRoot.get("defaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDomain)

strSQL = "SELECT displayname FROM 'LDAP://" & strDomain & "'" & _
" WHERE sAMAccountName='" & sAMAccountName & "'"
objCommand.CommandText = strSQL
Set objRS = objCommand.Execute
If objRS.RecordCount > 0 Then
With objRS
.MoveFirst
While Not .EOF
GetDisplayName = !DisplayName
.MoveNext
Wend
.Close
End With
End If
PROC_EXIT:
Set objRS = Nothing
Set objconn = Nothing
Set objCommand = Nothing
Set objRoot = Nothing
Set objDomain = Nothing

Exit Function
PROC_ERR:
MsgBox "Error getting display name for " & sAMAccountName & ". Error " & Err.Number & ": " & Err.Description, vbCritical
Resume PROC_EXIT
End Function
 
Upvote 0

Forum statistics

Threads
1,212,938
Messages
6,110,782
Members
448,297
Latest member
carmadgar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top