Is it a BUG or am I missing something?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Could you try the following case?

Lets create an excel workbook name is dummy1.xls including the code:
Private Sub Workbook_Deactivate()
MsgBox "deactivate"
End Sub
Private Sub Workbook_Open()
MsgBox "OLD message"
End Sub

And another workbook (dummy2.xls) to change dummy1 subs:
Sub ChangeMacros()
Dim vbc As VBComponent, i As Long, j As Long, strProcName As String, strTemp
As String
Dim strMacroList As String
Dim File
'On Error Resume Next
File = "c:\dummy1.xls"
Workbooks.Open Filename:=File, UpdateLinks:=0, ReadOnly:=False
strMacroList = ""
For Each vbc In ActiveWorkbook.VBProject.VBComponents
If vbc.Type = vbext_ct_Document Or vbc.Type = vbext_ct_StdModule Then
With vbc.CodeModule
If vbc.CodeModule = "ThisWorkbook" Then
i = .CountOfLines
If i <> 0 Then
.DeleteLines 1, i
End If
.InsertLines 100, _
"Private Sub Workbook_Open()" & Chr(13) & _
"msgbox ""NEW message""" & Chr(13) & _
"End Sub" & Chr(13)
End If
End With
End If
Next
ActiveWorkbook.Close True
End Sub

When I run ChangeMacros, excel is crashing. If I manually remove one of the
subs (open or deactivate) from dummy1 and try to run ChangeMacros" sub in
dummy2, it is running without any problem.

Thanks
 
Try disabling events before opening dummy1.xls. Consider also assigning
dummy1.xls to a workbook variable instead of just using the Activeworkbook
object.

Sub ChangeMacros()
Dim vbc As VBComponent, i As Long, j As Long, strProcName As String,
strTemp As String
Dim strMacroList As String
Dim File
Dim wb As Workbook
'On Error Resume Next
File = "c:\dummy1.xls"
Application.EnableEvents = False
Set wb = Workbooks.Open(Filename:=File, UpdateLinks:=0, ReadOnly:=False)
strMacroList = ""
For Each vbc In wb.VBProject.VBComponents
If vbc.Type = vbext_ct_Document Or vbc.Type = vbext_ct_StdModule Then
With vbc.CodeModule
If vbc.CodeModule = "ThisWorkbook" Then
i = .CountOfLines
If i < 0 Then
.DeleteLines 1, i
End If
.InsertLines 100, _
"Private Sub Workbook_Open()" & Chr(13) & _
"msgbox ""NEW message""" & Chr(13) & _
"End Sub" & Chr(13)
End If
End With
End If
Next
wb.Close True
Application.EnableEvents = True
End Sub
 
Back
Top