Remove code from all modules closes Excel

[Stuart]

User opens a single sheet workbook.
Code in the Workbook_Open event determines which
of 2 types of workbook they have opened (either
OrderMaster or ContractMaster)

Option Explicit
Dim wkbkname As String, ContractMaster As Boolean
Dim OrderMaster As Boolean

The code seems to successfully differentiate between the
two workbook types.

User then does their work. They then use Excel's Save or
Save As which fires the Workbook_BeforeSave Event.

Here is the complete code for that Event:

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim orderno As String, jobno As String
Dim fName As String, sStr As String

wkbkname = ActiveWorkbook.Name
If ThisWorkbook.Name = wkbkname Then
'user has not changed the filename
'get some example data
With Range("I9")
jobno = .Value
If jobno = "" Then
MsgBox "You must enter a Job Number in 'I9'"
Cancel = True
Exit Sub
End If
End With

With Range("J9")
orderno = CLng(Mid(.Value, 2, 4))
'what if "J9" value = "" ....error I think CHECK
If orderno = "" Then
orderno = "1001"
End If
End With
Range("A2").Select 'set user's view of the sheet
Application.EnableEvents = False
Cancel = True

If OrderMaster = True Then ' user is trying to save a Contract Master
Order
With ActiveWorkbook.Worksheets("Master Order")
.Unprotect Password:="SGB"
End With
Range("J9").Value = "/1000/" ' reset the order number
orderno = "1000" ' reset orderno
sStr = "E04" & jobno & "-" & orderno & "-" & "Master Order.xls"
fName = Application.GetSaveAsFilename(sStr, "Excel Files
(*.xls),*.xls)")
If fName <> ThisWorkbook.Name And fName <> "False" Then
ThisWorkbook.Protect Password:="SGB"
ThisWorkbook.SaveAs fName
End If
Application.EnableEvents = True
ActiveWorkbook.Close
' Application.EnableEvents = True
Exit Sub
End If

If ContractMaster = True Then
' It's just a standard order, so strip out the code before the save
' put up a message if you want
sStr = "E04" & jobno & "-" & orderno & " " & "Dickersons.xls"
MsgBox "You MUST save the file with a NEW name" & _
vbNewLine & vbNewLine & _
"Perhaps something like ..." & vbNewLine & sStr
'redefine sStr
sStr = "E04" & jobno & "-" & orderno & "-"
fName = Application.GetSaveAsFilename(sStr, "Excel Files
(*.xls),*.xls)")
End If
End If

If fName <> ThisWorkbook.Name And fName <> "False" Then
'strip all VBA from all modules --- it's no longer needed
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, _
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp

ThisWorkbook.SaveAs fName
End If

Application.EnableEvents = True
ActiveWorkbook.Close

End Sub

The OrderMaster routine is fine. I have no errors (as yet).
The ContractMaster routine is the problem.

It runs without any errors being displayed, but takes a
minute or so to complete. When finished, Excel has been
closed, the file has been saved, and the code has been
stripped.
The code in the originally-opened Workbook has
(correctly) not been stripped.

So all seems to work, except Excel closing on me.

Would really appreciate help to finally 'finish' this little
project, please.

Regards.