Delete then Insert Procedure

[gnod]

Hi,

i need to patch or modify the procedure the mistake i made with my templates. how do i programmatically delete then replace the procedure of Workbook_BeforeClose(Cancel As Boolean) in the thisworkbook.. i need to change the templates in a closed workbook..

From this procedure
[vba]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dtTestDate As Date

' If the test date is less than todays date, the file will not be saved
With Worksheets("Annual_EmpInfoSheet")
If .Range("Annual_HeaderData_BudgetYr") <> "" Then
dtTestDate = DateValue("1/15/" & .Range("Annual_HeaderData_BudgetYr"))
If dtTestDate < Date Then
MsgBox "Any changes you made will not be save. Annual Budget is already done."
Application.ThisWorkbook.Saved = True
Application.ThisWorkbook.Close
End If
End If
End With
End Sub
[/vba]

To this procedure
[vba]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dtTestDate As Date

' If the test date is less than todays date, the file will not be saved
With Worksheets("Annual_EmpInfoSheet")
If .Range("Annual_HeaderData_BudgetYr") <> "" And Range("BudgetType").value = "Annual" Then 'Additional condition
dtTestDate = DateValue("1/15/" & .Range("Annual_HeaderData_BudgetYr"))
If dtTestDate < Date Then
MsgBox "Any changes you made will not be save. Annual Budget is already done."
Application.ThisWorkbook.Saved = True
Application.ThisWorkbook.Close
End If
End If
End With
Enable_SaveAndSaveAs ' Additional
End Sub
[/vba]
kindly assist..


thanks..

[Bob Phillips]

[vba]

Sub DeleteProcedure()
Dim VBProj As Object
Dim VBComp As Object
Dim CodeMod As Object
Dim mpProcedure As String
Dim mpStartLine As Long
Dim mpNumLines As Long

Set VBProj = ActiveWorkbook.VBProject

Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

mpProcedure = "Workbook_BeforeClose"
With CodeMod

mpStartLine = .ProcStartLine(mpProcedure, 0) 'vbext_pk_Proc
mpNumLines = .ProcCountLines(mpProcedure, 0) 'vbext_pk_Proc
.DeleteLines StartLine:=mpStartLine, Count:=mpNumLines

mpStartLine = .CreateEventProc("BeforeClose", "Workbook") + 1
.InsertLines mpStartLine, _
"Dim dtTestDate As Date" & vbNewLine & vbNewLine & _
"' If the test date is less than todays date, the file will not be saved" & vbNewLine & _
" With Worksheets(""Annual_EmpInfoSheet"")" & vbNewLine & _
" If .Range(""Annual_HeaderData_BudgetYr"") <> """" And _" & vbNewLine & _
" .Range(""BudgetType"").Value = ""Annual"" Then 'Additional condition" & vbNewLine & _
" dtTestDate = DateValue(""1/15/"" & .Range(""Annual_HeaderData_BudgetYr""))" & vbNewLine & _
" If dtTestDate < Date Then" & vbNewLine & _
" MsgBox ""Any changes you made will not be save. Annual Budget is already done.""" & vbNewLine & _
" Application.ThisWorkbook.Saved = True" & vbNewLine & _
" Application.ThisWorkbook.Close" & vbNewLine & _
" End If" & vbNewLine & _
" End If" & vbNewLine & _
" End With" & vbNewLine & _
"Enable_SaveAndSaveAs ' Additional" & vbNewLine & _
"End Sub"
End With
End Sub
[/vba]

[gnod]

thanks xld..
is it possible to change the Workbook_BeforeClose procedure of a closed workbook?..

[Bob Phillips]

No, not really, as the VBA is embedded in the binary file, certainly in pre-2007 Excel.

[gnod]

do you have a suggestion how i will patch my procedure to the users? i already deploy my templates last year for their 2008 annual budget, now they will use it again for their 2008 mid-year budget.. the templates is more than 200 files and i don't want to open the file then modify the procedure for each everyone..

pls


thanks

[Bob Phillips]

Do the open, modify in a loop

[vba]

Public Sub LoopFilesAndUpdate()
Dim mpFilename As String
Dim mpWB As Workbook

mpFilename = Dir("C:\test\*.xls")

Do While mpFilename <> ""

Set mpWB = Workbooks.Open(mpFilename)
Call AmendProcedure(mpWB)
mpWB.Save
mpWB.Close
mpFilename = Dir
Loop

End Sub

Private Sub AmendProcedure(ByRef wb As Workbook)
Dim VBProj As Object
Dim VBComp As Object
Dim CodeMod As Object
Dim mpProcedure As String
Dim mpStartLine As Long
Dim mpNumLines As Long

Set VBProj = wb.VBProject

Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

mpProcedure = "Workbook_BeforeClose"
With CodeMod

mpStartLine = .ProcStartLine(mpProcedure, 0) 'vbext_pk_Proc
mpNumLines = .ProcCountLines(mpProcedure, 0) 'vbext_pk_Proc
.DeleteLines StartLine:=mpStartLine, Count:=mpNumLines

mpStartLine = .CreateEventProc("BeforeClose", "Workbook") + 1
.InsertLines mpStartLine, _
"Dim dtTestDate As Date" & vbNewLine & vbNewLine & _
"' If the test date is less than todays date, the file will not be saved" & vbNewLine & _
" With Worksheets(""Annual_EmpInfoSheet"")" & vbNewLine & _
" If .Range(""Annual_HeaderData_BudgetYr"") <> """" And _" & vbNewLine & _
" .Range(""BudgetType"").Value = ""Annual"" Then 'Additional condition" & vbNewLine & _
" dtTestDate = DateValue(""1/15/"" & .Range(""Annual_HeaderData_BudgetYr""))" & vbNewLine & _
" If dtTestDate < Date Then" & vbNewLine & _
" MsgBox ""Any changes you made will not be save. Annual Budget is already done.""" & vbNewLine & _
" Application.ThisWorkbook.Saved = True" & vbNewLine & _
" Application.ThisWorkbook.Close" & vbNewLine & _
" End If" & vbNewLine & _
" End If" & vbNewLine & _
" End With" & vbNewLine & _
"Enable_SaveAndSaveAs ' Additional" & vbNewLine & _
"End Sub"
End With
End Sub
[/vba]

[gnod]

thanks for your reply.. i'll try your solution..

thanks