vba code for changing the VBProject Properties sheet name has has stopped working.

[heathball]

Sub ZZcodechanger10()

'this code changes the property name to match the sheetname, and can have positive effects.

Sub ZZcodechanger10()
Dim varItem As Variant

For Each varItem In ActiveWorkbook.VBProject.VBComponents
'Type 100 is a worksheet
If varItem.Type = 100 And varItem.Name <> "ActiveWorkbook" Then
varItem.Name = varItem.Properties("Name").Value
End If
Next

End Sub

The following line is where the issue is

varItem.Name = varItem.Properties("Name").Value

It was working for a long time, and I am out of ideas,> perhaps someone knows something.

 

[heathball]

In the unlikely event that anyone finds this interesting, Below is what someone has produced with the same goal.
If the longer version below is aiming for "automation" of the naming of the sheets, I could not achieve it.
But i could rename the code using the "ZZZZ" example below, which is typing in the name on the module.

Private Sub ChangeCodeName(sh As Worksheet, strCodeName As String)
Dim shCModule As Object
Set shCModule = ActiveWorkbook.VBProject.VBComponents(sh.CodeName)
shCModule.Name = strCodeName
End Sub
Sub testFunctionChangeCodeName()
Dim sh As Worksheet
Set sh = Worksheets("ZZZZ") 'of course, this sheet name must exist...
ChangeCodeName sh, sh.Name
End Sub



Sub CodeNamesToNamesTEST()
CodeNamesToNames ThisWorkbook
End Sub

Sub CodeNamesToNames( _
ByVal wb As Workbook)
If wb Is Nothing Then Exit Sub

Const Dummy As String = "ZZZZ"

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare

Dim sh As Object
For Each sh In wb.Sheets
dict(sh.Name) = sh.CodeName
Next sh

Dim proj As Object: Set proj = wb.VBProject

Dim Key As Variant
Dim n As Long
Dim oName As String
Dim nName As String
Do
For Each Key In dict.Keys
If StrComp(Key, dict(Key), vbBinaryCompare) = 0 Then ' match
dict.Remove Key
Else ' not a match
oName = dict(Key)
On Error Resume Next
proj.VBComponents(oName).Name = Key
Select Case Err.Number
Case 0
dict.Remove Key ' successfully renamed
Case 32813 ' code name is taken
n = n + 1
nName = Dummy & n
proj.VBComponents(oName).Name = nName
dict(Key) = nName
Case 50132 ' invalid code name...
' must start with [A-Za-z]
' can only contain [A-Za-z0-9_]
dict.Remove Key ' ... cannot be renamed!
End Select
On Error GoTo 0
End If
Next Key
Loop Until dict.Count = 0

End Sub