Code: Select all
Sub ReplaceText()
Const OldText = "2. February 2019"
Const NewText = "3. March 2019"
Dim Folder As String
Dim File As String
Dim Wbk As Workbook
Dim NumLines As Long
Dim Lines As String
With Application.FileDialog(4) ' msoFileDialogFolderPicker
If .Show Then
Folder = .SelectedItems(1)
Else
MsgBox "You didn't select a folder!", vbExclamation
Exit Sub
End If
End With
Application.ScreenUpdating = False
Folder = Folder & "\"
File = Dir(Folder & "*.xlsm")
Do While File <> ""
If UCase(File) <> UCase(ThisWorkbook.Name) Then
Set Wbk = Workbooks.Open(Folder & File)
With Wbk.VBProject.VBComponents("Module1").CodeModule
NumLines = .CountOfLines
Lines = .Lines(1, NumLines)
Lines = Replace(Lines, OldText, NewText)
.DeleteLines 1, NumLines
.AddFromString Lines
End With
Wbk.Close SaveChanges:=True
End If
File = Dir
Loop
Application.ScreenUpdating = True
End Sub