|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE
Hi there. I'm using the following coding and am wondering if it is possible to be able to only have the macro save the document if there was actually a change made to it? The user wants to use this macro to change any documents that contain a certain search term easily, but then wants to be able to identify exactly which documents were actually changed. Currently the code opens all the documents, does the search and replace, and then saves the document. The modified date on the document then changes to the current date and time and there is no way for me to identify which document was actually changed. Is this possible or is there a better way of doing this?
Thank you so much!! Code:
Sub Loop_AllWordFiles_inFolder() 'macro created by Michelle Peters August 12, 2022 'Optimize Macro Speed Application.ScreenUpdating = False Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document Dim strFind As String, strRplc As String Dim strWildCrd As Integer 'Have user enter the search and replace strings and if there are wildcards strFind = InputBox("Enter your search string and use wildcards if necessary.") strRplc = InputBox("Enter your replace string and use wildcards if necessary.") strWildCrd = MsgBox("Do either your search or replace string contain wildcard characters?", vbQuestion + vbYesNo + vbDefaultButton2, "Wildcards") strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) strDocNm = ThisDocument.FullName While strFile <> "" If strFolder & " \ " & strFile <> strDocNm Then Set wdDoc = Documents.Open(FileName:=strFolder & " \ " & strFile, AddToRecentFiles:=False, Visible:=True) With wdDoc Call FindReplaceAnywhere(wdDoc, strFind, strRplc, strWildCrd) .Close SaveChanges:=True End With End If strFile = Dir() Wend MsgBox "Finished scanning all files in Folder " & Path Set wdDoc = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").browseforfolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.items.Item.Path Set oFolder = Nothing End Function Sub FindReplaceAnywhere(wDoc As Document, ByVal strFind As String, ByVal strRplc As String, ByVal strWildCrd As Integer) 'macro created by Michelle Peters March 18, 2022 'macro created to loop through all stories in Word to replace text Dim rngStory As Word.Range Dim lngValidate As Long Dim oShp As Shape 'Fix the skipped blank header/footer problem lngValidate = wDoc.Sections(1).Headers(1).Range.StoryType 'Iterate through all stroy types in the current document For Each rngStory In wDoc.StoryRanges 'Iterate through all linked stories Do If strWildCrd = vbYes Then SearchandReplaceWild rngStory, strFind, strRplc Else SearchandReplaceInStory rngStory, strFind, strRplc End If On Error Resume Next Select Case rngStory.StoryType Case 6, 7, 8, 9, 10, 11 If rngStory.ShapeRange.Count > 0 Then For Each oShp In rngStory.ShapeRange If oShp.TextFrame.HasText Then If strWildCrd = vbYes Then SearchandReplaceWild oShp.TextFrame.TextRange, strFind, strRplc Else SearchandReplaceInStory oShp.TextFrame.TextRange, strFind, strRplc End If End If Next End If Case Else 'do Nothing End Select On Error GoTo 0 'get next linked story (if any) Set rngStory = rngStory.NextStoryRange Loop Until rngStory Is Nothing Next wDoc.BuiltInDocumentProperties(wdPropertyComments) = strRplc lbl_exit: Exit Sub End Sub Sub SearchandReplaceInStory(ByVal rngStory As Word.Range, ByVal strSearch As String, ByVal strReplace As String) With rngStory.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Wrap = wdFindContinue .MatchWildcards = False .Execute Replace:=wdReplaceAll End With lbl_exit: Exit Sub End Sub Sub SearchandReplaceWild(ByVal rngStory As Word.Range, ByVal strSearch As String, ByVal strReplace As String) With rngStory.Find .ClearFormatting .Replacement.ClearFormatting .Text = strSearch .Replacement.Text = strReplace .Wrap = wdFindContinue .MatchWildcards = True .Execute Replace:=wdReplaceAll End With lbl_exit: End Sub Last edited by macropod; 08-15-2022 at 05:12 PM. Reason: Applied code tags to restore code formatting |
#2
|
||||
|
||||
The line '.Close SaveChanges:=True' only re-saves the document if any changes have actually been made. The problem lies in your code, which explicitly updates wDoc.BuiltInDocumentProperties(wdPropertyComments) without checking whether any changes have been made or whether it already matches strRplc.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Loop Through all documents in a folder | ballpoint | Word VBA | 10 | 08-15-2022 05:24 PM |
Macro to Change Document Font in All Documents in a Folder | jtomolonis08 | Word VBA | 1 | 06-07-2019 05:59 PM |
Can't Find Word Document in Search or in Folder But It's There in Recent Documents | CrossReach | Word | 1 | 10-14-2016 01:27 PM |
Find & replace footer text in a folder of Word 2010 documents | kennethc | Word | 3 | 03-28-2015 02:49 AM |
how to search and replace BOLD text >> font color change? | dylansmith | Word | 4 | 03-12-2013 09:51 PM |