MS Word wizard?

Page may contain affiliate links. Please see terms for details.

Corrado

Active Member
Joined
Nov 28, 2007
Messages
224
Location
Sussex Coast
Car
Civit 1.8VTEC
Is anyone out there an MS Word wizard?

I have a few hundred word files with file names in numerical sequence ie. fred056.doc, fred057.doc, fred058.doc

The snag is they all contain a single error that needs to be corrected, so a "find and replace" run on each of them automatically to correct the text would be far preferrable than having to go through each individually. I just hope there's an answer - if I have to give this task to someone to hand crank they won't be a happy bunny.

I've used macros a few times but not to open a sequence of files and modify them.

MBClub Oracle, are you there :)?
 
Are you saying the file names are wrong or the content of each document?
 
If you are saying that many documents have an error that needs replaced one at a time.
Try this one I have used it in the past to multiple edit stuff.
If I were you, I would put all those doc files in one folder and make a back up first.


FREEWARE Windows Search and Replace Software

Download from
Free Windows Search and Replace Software

Alex.
 
Are you saying the file names are wrong or the content of each document?

No, the file names are fine, its just that there's a common reference number within each document that needs to be modified (from 0003 to 0004)
 
If you are saying that many documents have an error that needs replaced one at a time.
Try this one I have used it in the past to multiple edit stuff.
If I were you, I would put all those doc files in one folder and make a back up first.


FREEWARE Windows Search and Replace Software

Download from
Free Windows Search and Replace Software

Alex.

Thanks, looks interesting. Unfortunately, downloading stuff is a no-no from here.
 
Try this macro - change path and find replace as necessary (and do on a backup). You should be able to cut/paste - so no avoid any download issues.

Sub Steve()
'
' Steve Macro
' Macro created 9/22/2009 by Steve
'
Dim strPath As String
Dim strNewPath As String
Dim strFullPathDoc As String
Dim strFileName As String


strPath = "D:\My Documents\TestFolder\"
strFullPathDoc = Dir(strPath & "*.doc", vbNormal)
Do While strFullPathDoc <> ""
strFileName = ExtractFileName(strFullPathDoc)

Documents.Open strPath & strFileName

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "0003"
.Replacement.Text = "0004"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Save
ActiveWindow.Close

strFullPathDoc = Dir ' Get next entry.
Loop
End Sub
Function ExtractFileName(strFullPath As String)
Dim txt As String

On Error Resume Next
txt = "" & strFullPath
While InStr(txt, "\") > 0
txt = Mid$(txt, InStr(txt, "\") + 1)
Wend
If InStr(txt, ":") > 0 Then
txt = Mid$(txt, InStr(txt, ":") + 1)
End If
ExtractFileName = txt
End Function


P.S. Not all my work ;)
 
Try this macro - change path and find replace as necessary (and do on a backup). You should be able to cut/paste - so no avoid any download issues.

Sub Steve()
'
' Steve Macro
' Macro created 9/22/2009 by Steve
'
Dim strPath As String
Dim strNewPath As String
Dim strFullPathDoc As String
Dim strFileName As String


strPath = "D:\My Documents\TestFolder\"
strFullPathDoc = Dir(strPath & "*.doc", vbNormal)
Do While strFullPathDoc <> ""
strFileName = ExtractFileName(strFullPathDoc)

Documents.Open strPath & strFileName

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "0003"
.Replacement.Text = "0004"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Save
ActiveWindow.Close

strFullPathDoc = Dir ' Get next entry.
Loop
End Sub
Function ExtractFileName(strFullPath As String)
Dim txt As String

On Error Resume Next
txt = "" & strFullPath
While InStr(txt, "\") > 0
txt = Mid$(txt, InStr(txt, "\") + 1)
Wend
If InStr(txt, ":") > 0 Then
txt = Mid$(txt, InStr(txt, ":") + 1)
End If
ExtractFileName = txt
End Function


P.S. Not all my work ;)

All 870 done!!

Thanks very much. Many:bannana::bannana: to you Steve.

That deserves a (even if its nowt to do with MBs)
 

Users who are viewing this thread

Back
Top Bottom