Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
I have a code that searches and replaces. I want it only to save and print
if a change is made. Here's my code. 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 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 Thanks for the help |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Save changes? even when you've made none | Excel Discussion (Misc queries) | |||
Do you want to save the changes you made to 'ABC.xls'? | Excel Discussion (Misc queries) | |||
save changes when no changes made | Excel Discussion (Misc queries) | |||
i made one spreadsheet but when i try to print two sheets print, | Excel Discussion (Misc queries) | |||
i made change in a current workbook and accidentally save it, can. | Excel Discussion (Misc queries) |