VBA Applications for SAP BO 4.2

[elugari]

I have a series of VBA utilities which damp on excel user list, users group, report list ect.....

Recently our office excel version as excel 365 MSO (16.0.13801.21072 64 bit)

All my utilities now not working anymore as I'm getting an error as

VBAProject - - 2147221164:Class not registered 1000440

Any idea which libraru is missing from this new version of excel that need to be added?

Example of utility

Private Sub cbExtract_Click()
Application.ScreenUpdating = False
Dim ModeRecalcul As Long
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

' lastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
' lastCol = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column

'Reset cell high lighting
' Range(Cells(3, 1), Cells(lastRow, lastCol)).Interior.ColorIndex = xlColorIndexNone
Range("A3:Z65000").Interior.ColorIndex = xlColorIndexNone

'Purge existing data
Sheets("Users").Range("A3:Z65000").ClearContents

'session declaration
Dim SessionManager As SessionMgr
Dim esession As EnterpriseSession

'Infostore declaration
Dim iStore As InfoStore

'Info Objects declaration
Dim Users, Groups, Favourites, Inboxes As InfoObjects
Dim UserItem, GroupItem, FavouriteItem, InboxItem As InfoObject

'User Object declaration
Dim UserObject As User

Dim Rng As Excel.Range
Dim RowNum, GroupNum As Long

On Error GoTo ErrorHandler
Dim ErrorState As String

'Create an instance of a Session
Set SessionManager = CreateObject("CrystalEnterprise.SessionMgr")

'Connect to CMS using Enterprise authentication
Set esession = SessionManager.Logon(tbName, tbPassword, tbCMS, "secEnterprise")

'Create an Infostore instance
Set iStore = esession.Service("", "InfoStore")

'document the users
Set Users = iStore.Query("SELECT TOP 1000000 SI_EMAIL_ADDRESS, SI_FORCE_PASSWORD_CHANGE, SI_NAME, SI_ID, SI_USERGROUPS, SI_USERFULLNAME, SI_ALIASES, SI_DESCRIPTION, SI_LASTLOGONTIME, SI_PASSWORDEXPIRE, " & _
"SI_CREATION_TIME, SI_CHILDREN, SI_INBOX, SI_PERSONALCATEGORY, SI_FAVORITES_FOLDER, SI_NAMEDUSER, SI_UPDATE_TS " & _
"FROM CI_SYSTEMOBJECTS " & _
"Where SI_KIND='User'")

userCount = Users.Count
Set Rng = Sheets("Users").Cells

'----------------------------------------------------------------------------------------------------------------------------
' Write header details user count, server/login used, the update date
'----------------------------------------------------------------------------------------------------------------------------
Rng(1, 4) = "Server: " & tbCMS & Chr(10) & "User: " & tbName & Chr(10) & "Update Date: " & Date
Rng(1, 3) = "User Count: " & userCount

RowNum = 2
Rng(RowNum, 1) = "ID"
Rng(RowNum, 2) = "Login"
Rng(RowNum, 3) = "FullName"
Rng(RowNum, 4) = "Email Address"
Rng(RowNum, 5) = "Groups"
Rng(RowNum, 6) = "Disabled"
Rng(RowNum, 7) = "Never Connected"
Rng(RowNum, 😎 = "Description"
Rng(RowNum, 9) = "Created Date"
Rng(RowNum, 10) = "Last Login Date"
Rng(RowNum, 11) = "Last Update Date"
Rng(RowNum, 12) = "Named User"
'----------------------------------------------------------------------------------------------------------------------------
' Get details for ALL users
'----------------------------------------------------------------------------------------------------------------------------
For Each UserItem In Users
Set UserObject = UserItem

RowNum = RowNum + 1
Rng(RowNum, 1) = UserItem.ID
Rng(RowNum, 2) = UserItem.Title

ErrorState = "FullName"

Rng(RowNum, 3) = UserObject.FullName
Rng(RowNum, 4) = UserObject.EmailAddress

GroupNum = 0
For Each GroupId In UserObject.Groups
GroupNum = GroupNum + 1
Set Groups = iStore.Query("SELECT SI_NAME FROM CI_SYSTEMOBJECTS Where SI_ID=" & GroupId)
If (GroupNum = 1) Then
Rng(RowNum, 5) = Groups(1).Title
Else:
Rng(RowNum, 5) = Rng(RowNum, 5) & Chr(10) & Groups(1).Title
End If
Next GroupId

If (UserObject.Aliases(1).Disabled) Then
Rng(RowNum, 6) = 1
Rng(RowNum, 6).Interior.ColorIndex = 3 'Red
Else
Rng(RowNum, 6) = 0
Rng(RowNum, 6).Interior.ColorIndex = xlColorIndexNone
End If
If (UserObject.ChangePasswordAtNextLogon) Then
Rng(RowNum, 7) = 1
Rng(RowNum, 7).Interior.ColorIndex = 3 'Red
Else
Rng(RowNum, 7) = 0
Rng(RowNum, 7).Interior.ColorIndex = xlColorIndexNone
End If
Rng(RowNum, 😎 = UserObject.Description

ErrorState = "LastLogon"

Rng(RowNum, 9) = UserObject.Properties("SI_CREATION_TIME")
Rng(RowNum, 10) = UserObject.Properties("SI_LASTLOGONTIME")
Rng(RowNum, 11) = UserObject.Properties("SI_UPDATE_TS")
Rng(RowNum, 12) = UserObject.Properties("SI_NAMEDUSER")

Next UserItem

Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
Me.Hide
CleanUp:
Me.Hide
On Error Resume Next
esession.Logoff
Application.Calculation = ModeRecalcul
Calculate
Application.EnableEvents = True
Exit Sub

ErrorHandler:
If Err.Number = -2147210697 Then
If ErrorState = "FullName" Then Rng(RowNum, 3) = "Error on Full Name"
If ErrorState = "LastLogon" Then Rng(RowNum, 9) = ""
Resume Next
End If
Me.Hide
MsgBox Err.Source & " - " & Err.Number & ": " & Err.Description & " " & Err.HelpContext, _
vbCritical, "Failure in UsersGroups()"
Resume CleanUp

End Sub

Private Sub Frame1_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub Label6_Click()

End Sub

Private Sub tbPassword_Change()

End Sub

Private Sub UserForm_Click()

End Sub

[denis_konovalov]

I have changed your tag to better target audience that can help you.

[DellSC]

You'll need to upgrade your code to use a newer version of the .NET platform in order to work with Office 365. Which version of Excel were you using prior to the upgrade?

-Dell