#1
|
|||
|
|||
Find and Replace whole folder content - Word files
Much pretty sure about getting solution from this forum!
Got a code, and the code needs execution so that the pointed folder, containing Word files, completely 'Find and Replace' the files' content in whole. Much obliged if the below code gets optimized too (quick execution)! Below is the F/R code: Code:
Sub FindAndReplaceMultiItems() Dim strFindText As String Dim strReplaceText As String Dim nSplitItem As Long Application.ScreenUpdating = False strFindText = "northenn,westenn" strReplaceText = "northern,western" nSplitItem = UBound(Split(strFindText, ",")) ' Find each item and replace it with new one respectively. For nSplitItem = 0 To nSplitItem With Selection .HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = Split(strFindText, ",")(nSplitItem) .Replacement.Text = Split(strReplaceText, ",")(nSplitItem) .Format = False .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End With Next nSplitItem Application.ScreenUpdating = True MsgBox "DONE EXECUTION" End Sub Last edited by Leslie; 03-01-2020 at 11:07 AM. Reason: added description |
#2
|
||||
|
||||
See, for example: https://www.msofficeforums.com/45854-post2.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Quote:
However, 5 out of 6 files of the folder never get updated (except the opened *.docx file) and that too not saved automatically after being run (seeing it manual save works). Any help, much appreciated. Code:
Sub FindReplaceAllFilesInFolder() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document strDocNm = ActiveDocument.FullName: strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.docx", vbNormal) While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc Call FnR .Close SaveChanges:=True End With End If strFile = Dir() Wend 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 FnR() Dim strFindText As String Dim strReplaceText As String Dim nSplitItem As Long Application.ScreenUpdating = False strFindText = "northenn,westenn" strReplaceText = "northern,western" nSplitItem = UBound(Split(strFindText, ",")) ' Find each item and replace it with new one respectively. For nSplitItem = 0 To nSplitItem With Selection .HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = Split(strFindText, ",")(nSplitItem) .Replacement.Text = Split(strReplaceText, ",")(nSplitItem) .Format = False .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End With Next nSplitItem Application.ScreenUpdating = True MsgBox "DONE EXECUTION" End Sub Last edited by Leslie; 03-01-2020 at 08:12 PM. Reason: code added |
#4
|
||||
|
||||
So how have you implemented the code? Without seeing you implementation, it's impossible to know what the issue is.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Quote:
Code:
Sub FindReplaceAllFilesInFolder() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document strDocNm = ActiveDocument.FullName: strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.docx", vbNormal) While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc Call FnR .Close SaveChanges:=True End With End If strFile = Dir() Wend 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 FnR() Dim strFindText As String Dim strReplaceText As String Dim nSplitItem As Long Application.ScreenUpdating = False strFindText = "northenn,westenn" strReplaceText = "northern,western" nSplitItem = UBound(Split(strFindText, ",")) ' Find each item and replace it with new one respectively. For nSplitItem = 0 To nSplitItem With Selection .HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = Split(strFindText, ",")(nSplitItem) .Replacement.Text = Split(strReplaceText, ",")(nSplitItem) .Format = False .MatchWholeWord = False End With Selection.Find.Execute Replace:=wdReplaceAll End With Next nSplitItem Application.ScreenUpdating = True MsgBox "DONE EXECUTION" End Sub |
#6
|
|||
|
|||
Quote:
|
#7
|
||||
|
||||
OK, aside from the issue that I very much doubt your original code came from the forum, you can't use 'Selection' objects when (as the macro in the link does) the document being opened for processed remains invisible. The consequence of using your code the way you've done is that only the document containing the code gets processed. A simple approach is to use:
Code:
Sub FindReplaceAllFilesInFolder() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document strDocNm = ActiveDocument.FullName: strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.docx", vbNormal) While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc Call FnR(.Range) .Close SaveChanges:=True End With End If strFile = Dir() Wend 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 FnR(Rng As Range) Dim strFindText As String, strReplaceText As String, nSplitItem As Long strFindText = "northenn,westenn" strReplaceText = "northern,western" With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = False .MatchCase = False .MatchWholeWord = False .Wrap = wdFindContinue For nSplitItem = 0 To UBound(Split(strFindText, ",")) .Text = Split(strFindText, ",")(nSplitItem) .Replacement.Text = Split(strReplaceText, ",")(nSplitItem) .Execute Replace:=wdReplaceAll Next End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Code:
Sub FnR(Rng As Range) Dim strFindText As String, strReplaceText As String, nSplitItem As Long strFindText = "northenn,westenn" strReplaceText = "northern,western" With Rng.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = False .MatchCase = False .MatchWholeWord = False .Wrap = wdFindContinue For nSplitItem = 0 To UBound(Split(strFindText, ",")) .Text = Split(strFindText, ",")(nSplitItem) .Replacement.Text = Split(strReplaceText, ",")(nSplitItem) .Execute Replace:=wdReplaceAll Next End With End Sub Perfect code! Thanks dear Paul Edstein @macropod. |
Tags |
macro, multiple find and replace |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Static Folder Locations to Automate a Find and Replace using Word VBA | rmoyar | Word VBA | 9 | 01-29-2020 02:35 PM |
Need to find/replace text in many word files - but text is in embedded word files | semple.13 | Word VBA | 5 | 11-03-2015 01:20 PM |
Find & replace footer text in a folder of Word 2010 documents | kennethc | Word | 3 | 03-28-2015 02:49 AM |
VBA Batch Find & Replace for all MSOffice extensions, to replace File Name and Content of the File | QA_Compliance_Advisor | Word VBA | 11 | 09-11-2014 11:51 PM |
Macro to replace SSN in all files within a folder | caj1980 | Word VBA | 7 | 09-11-2014 04:17 PM |