Save and print if change made
 

Sub ReplaceAndPrint()

' strFolder = "path to main folder"
strFolder = "C:\Documents and Settings\dwilson\Desktop\Correction"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call ReplaceAndPrintSubFolder(strFolder + "\")
End Sub

Sub ReplaceAndPrintSubFolder(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call ReplaceAndPrintSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and 1 on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, one on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Worksheets("Report").Select
Range("I2").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End With

If Err.Number 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub

Save and print if change made
 

Check your other post.

Kiba wrote:

Sub ReplaceAndPrint()

' strFolder = "path to main folder"
strFolder = "C:\Documents and Settings\dwilson\Desktop\Correction"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call ReplaceAndPrintSubFolder(strFolder + "\")
End Sub

Sub ReplaceAndPrintSubFolder(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call ReplaceAndPrintSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and 1 on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, one on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Worksheets("Report").Select
Range("I2").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End With

If Err.Number 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub

--

Dave Peterson