K
Kiba
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
' 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