batch find/replace and mass rtf conversion

[skrampach]

I have a thousand or so documents I need to change "Licence No AA", "Licence
No BB" and "Licence No CC" to "Licence No XX".

I can't imagine doing this one at a time...

1) Can anyone tell me how to batch replace text in word and rtf files?

2) How about mass convert all word files to rtf?

 

[Graham Mayor]

You'll need a macro. The following will open all the DOC format files in a
folder selected from the macro, find the strings defined at vFindText and
replace them all with the same string defined at vReplText, then saves as
RTF format in the same folder. The original document is closed without
saving the changes.

May I suggest that you test it on a couple of documents in a temporary
folder to ensure that it catches all the changes.

http://www.gmayor.com/installing_macro.htm

Sub SaveAllAsRTF()
Dim strFileName As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim Response As Long
Dim fDialog As FileDialog
Dim vFindText As Variant
Dim vReplText As String
Dim i As Long

vFindText = Array("Licence No AA", "Licence No BB", "Licence No CC")
vReplText = "Licence No XX"

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "Save all as RTF"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If

strFileName = Dir$(strPath & "*.doc")

While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)

With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText
.Execute Replace:=wdReplaceAll
Next i
End With
End With

strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".rtf"
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatRTF, AddtorecentFiles:=False
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFileName = Dir$()
Wend
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[skrampach]

Hi, I installed the macro but it does not find any rtf files. I was looking
to batch replace text in word and rtf files. I have no doc files in the rtf
folder as yet.
I changed the "*.doc" to "*.rtf" but it still does not see rets...




:,

 

[Graham Mayor]

You asked to convert documents to RTF, which is what the macro does. Do you
want to convert the RTF to DOC or leave them as RTF?

If you only change DOC to RTF the documents would be saved as RTF which
would explain why you are not seeing DOC files.

Did the macro change the licence numbers from those you set in
vFindText = Array("Licence No AA", "Licence No BB", "Licence No CC") to that
you set in
vReplText = "Licence No XX" ?

To open RTF or DOC and save as DOC, the code requires a few more lines. I
have also added _rtf to the end of the filename when the document was
previously rtf format to try and avoid filename conflicts.


Sub SaveAllAsDOC()
Dim strFileName As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim Response As Long
Dim fDialog As FileDialog
Dim vFindText As Variant
Dim vReplText As String
Dim sOptions As Boolean
Dim i As Long

vFindText = Array("Licence No AA", "Licence No BB", "Licence No CC")
vReplText = "Licence No XX"
sOptions = Options.ConfirmConversions
Options.ConfirmConversions = False

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "Save all as RTF"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If

strFileName = Dir$(strPath & "*.*")
If UCase(Right(strFileName, 3)) = "RTF" Or _
UCase(Right(strFileName, 3)) = "DOC" Then

While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)

With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText
.Execute Replace:=wdReplaceAll
Next i
End With
End With

strDocName = ActiveDocument.FullName
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
If UCase(Right(ActiveDocument.name, 3)) = "RTF" Then
strDocName = strDocName & "_rtf.doc"
Else
strDocName = strDocName & ".doc"
End If
oDoc.SaveAs FileName:=strDocName, _
FileFormat:=wdFormatDocument, AddtorecentFiles:=False
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFileName = Dir$()

Wend
End If
Options.ConfirmConversions = sOptions
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>