Macro to replace current text with same text plus some

[aerotek1234]

I would like to have a Macro that looks for a certain string through a document and replaces the first instance of it with the current text plus some additional.

[macropod]

You don't need a macro for that - you can do it quite simply via Find/Replace. For example:
Find = Some Text
Replace = Prefix ^& Suffix

[Rakesh]

Try
Put your text within Brackets as bolded
Sub cc()
ActiveDocument.Content.Find.execute _
FindText:="(Your Text)", _
MatchWildcards:=True, _
ReplaceWith:="\1Additional Text", _
replace:=wdReplaceAll
End Sub

[aerotek1234]

I have about 2000 documents that I want to update. The text is specific to Versions of a document. So it says "Version A" or "Version B", etc. I am looking to use the Macro to update the text to say "Version A.new" Just trying to keep what ever it says and then add the .new

[macropod]

Try:

Sub UpdateDocumentVersions()
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 & "\*.doc", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.MatchWildcards = True
.Wrap = wdFindContinue
.Text = "Version [A-Z]"
.Replacement.Text = "^&.new"
.Execute Replace:=wdReplaceAll
End With
.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
The macro includes its own folder browser. Simply point it to the folder of files you want to update and it will process all files in that folder. As coded, only content in the body of the document gets updated.

[aerotek1234]

That sounds like it will work. So I just need to add the starting folder correct. Where do I enter the Macro? Also how can I have it search headers and footers.

[macropod]

So I just need to add the starting folder correct.
No. As I said, the macro includes a folder browser.

Where do I enter the Macro?
In a code module. For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm.

Also how can I have it search headers and footers.
with code like:

Sub UpdateDocumentVersions()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
Call FndRepRange(.Range)
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
Call FndRepRange(HdFt.Range)
Next
For Each HdFt In Sctn.Footers
Call FndRepRange(HdFt.Range)
Next
Next
.Close SaveChanges:=True
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
'
Sub FndRepRange(Rng As Range)
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.MatchWildcards = True
.Wrap = wdFindContinue
.Text = "Version [A-Z]"
.Replacement.Text = "^&.new"
.Execute Replace:=wdReplaceAll
End With
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

[aerotek1234]

That works except for I am getting Version A.new.new after running. I also wondering if I can have the file saved as the same file name but with a "_new" after the current file name.

[macropod]

That works except for I am getting Version A.new.new after running.
That suggests you're running the code on file that already have Version A.new in them.

I also wondering if I can have the file saved as the same file name but with a "_new" after the current file name.
Change:
.Close SaveChanges:=True
to:

.SaveAs FileName:=Split(.FullName, ".")(0) & "_new" & Split(.FullName, ".")(1), _
FileFormat:=.SaveFormat, AddToRecentFiles:=False
.Close

[aerotek1234]

Thanks for all the help. One last question, what is needed to be added to allow it seach subfolders as well.

[aerotek1234]

I modified the code to suit the exact needs of the document:

.Text = "Rev: [A-Z]"
.Replacement.Text = "^.admin"

And am still getting the results coming back as Rev: A.admin.admin

[macropod]

Thanks for all the help. One last question, what is needed to be added to allow it seach subfolders as well.
A major re-write. I'm not going to do that. I you wanted code to process sub-folders, you should have specified that at the outset.

[macropod]

still getting the results coming back as Rev: A.admin.admin
That doesn't change the thrust of my previous advice.