Compile Error on GetUserName

[mrbeanyuk]

Good morning,

I have added a GetUserName function to my spreadsheet which has worked perfectly over the last few months. However, since moving the code from a button to a Yes/No dialogue box on startup, users are receiving a compile error when they open the spreadsheet. Interestingly, it still works fine on my PC. All ideas welcome!

Thanks very much

Private Sub Workbook_Open()

Dim FR
Dim answer As Integer
Dim objInfo
Dim strLDAP
Dim strFullName
Dim LR
Set objInfo = CreateObject("ADSystemInfo")
strLDAP = objInfo.UserName
Set objInfo = Nothing
strFullName = GetUserName(strLDAP)

With Sheets("1718 KPIs")
   FR = .Cells(.Rows.Count, 2).End(xlUp).Row
    .Cells(2, 4).AutoFilter Field:=4, Criteria1:="Monthly"

     
answer = MsgBox("Would you like to go directly to your KPIs?", vbYesNo + vbQuestion, "Question 1")

If answer = vbYes Then

    With Sheets("1718 KPIs")
        LR = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(2, 7).AutoFilter Field:=7, Criteria1:=strFullName

'MsgBox "Now Complete Columns AR and BD. Add commentary and mitigation if Amber or Red", vbOKOnly, "Question 2"

End With
Else
     'do nothing
End If
End With

'MsgBox "Select 'Show my KPIs'" & vbNewLine & "Once complete select 'Submit KPIs'", vbOKOnly

End Sub



Sub Users_Fullname()
 
Dim objInfo
Dim strLDAP
Dim strFullName
Dim LR
Set objInfo = CreateObject("ADSystemInfo")
strLDAP = objInfo.UserName
Set objInfo = Nothing
strFullName = GetUserName(strLDAP)
  
'MsgBox "Full name of User is " & strFullName  (step to test)

'filter
With Sheets("1718 KPIs")
    LR = .Cells(.Rows.Count, 2).End(xlUp).Row
    .Cells(2, 7).AutoFilter Field:=7, Criteria1:=strFullName
    
          
End With

End Sub

Sub Users_Fullname1()
 
Dim objInfo
Dim strLDAP
Dim strFullName
Dim LR
    
Set objInfo = CreateObject("ADSystemInfo")
strLDAP = objInfo.UserName
Set objInfo = Nothing
strFullName = GetUserName(strLDAP)
  
'MsgBox "Full name of User is " & strFullName  (step to test)

'filter

With Sheets("1718 KPIs")
    LR = .Cells(.Rows.Count, 2).End(xlUp).Row
    .Cells(2, 8).AutoFilter Field:=8, Criteria1:=strFullName
           
End With

End Sub
 
Function GetUserName(strLDAP)
  Dim objUser
  Dim strName
  Dim arrLDAP
  Dim intIdx
  
 'Get name
  On Error Resume Next
  strName = ""
  Set objUser = GetObject("LDAP://" & strLDAP)
  If Err.Number = 0 Then
    strName = objUser.Get("givenName") & chr(32) & objUser.Get("sn")
  End If
  If Err.Number <> 0 Then
    arrLDAP = Split(strLDAP, ",")
    For intIdx = 0 To UBound(arrLDAP)
      If UCase(Left(arrLDAP(intIdx), 3)) = "CN=" Then
        strName = Trim(Mid(arrLDAP(intIdx), 4))
      End If
    Next
  End If
  Set objUser = Nothing
  
  GetUserName = strName
  
End Function

Sub AutoFilter_Remove()
'Remove filter

Dim FR

ActiveSheet.ShowAllData
    With Sheets("1718 KPIs")
    FR = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(2, 4).AutoFilter Field:=4, Criteria1:="Monthly"
    '    .Cells(2, 4).AutoFilter Field:=4
        
End With
End Sub

 

[RoryA]

Check the project references on one of the users' machines - something should be flagged as 'MISSING:'

 

[mrbeanyuk]

Check the project references on one of the users' machines - something should be flagged as 'MISSING:'

Thanks RoryA - spot on!