Changing text contained in the footer of multiple files via a macro?

[Jim Fox]

Ron de Bruin gave some great code for basically updating the same cell on
every excel file within a directory by running a macro. Which saves a ton
of time not having to open all 180 files individually and changing the cell.


Now I would like to know if we could change the info in the footer via a
macro for every file in a directory.

The supplier who set up the spreadsheets put a hardcoded date in the footer.
So basically I need to do a find and replace in 180 files for 'March 29,
2004' and change it to whatever the date is, or maybe we can make it a
function of Date so I don't have to find and replace every stinking time.

Anyone got any code that could handle this? I'm basically a excel coding
noob.

THANKS IN ADVANCE.

 

[Dave Peterson]

This might work for you:

Option Explicit
Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myFiles) To UBound(myFiles)
Set wkbk = Workbooks.Open(myPath & myFiles(fCtr))
For Each wks In wkbk.Worksheets
With wks.PageSetup
.LeftFooter = "&D"
End With
Next wks
wkbk.Close savechanges:=True
Next fCtr
End If

End Sub