Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-15-2022, 10:51 AM
shpkmom shpkmom is offline loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Windows 11 loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Office 2021
Novice
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE
 
Join Date: Aug 2022
Posts: 2
shpkmom is on a distinguished road
Default 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
Reply With Quote
  #2  
Old 08-15-2022, 05:16 PM
macropod's Avatar
macropod macropod is offline loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Windows 10 loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Loop Through all documents in a folder ballpoint Word VBA 10 08-15-2022 05:24 PM
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE Macro to Change Document Font in All Documents in a Folder jtomolonis08 Word VBA 1 06-07-2019 05:59 PM
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE 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
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE 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

Other Forums: Access Forums

All times are GMT -7. The time now is 03:34 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft