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]