Find and Replace text in Word document from Access with VBA 3

[trueharted]

I've taken code from a Word macro and combined it with some other VBA code to open a Word document and find and replace text based on user input. The code looks to a table to find the location of the file. I've referenced Microsoft Word 9.0 Object Library.

Originally when I stepped through the code, when I got to the line:

.Text=strFindText

I got an Access generated errors and will terminate error. (I tried this about five times and got the same error, even after rebooting.)

Just now I stepped through it again and it executed all the way through and successfully opened the document. However when it finished and I looked at the document, the word hadn't been replaced!

I even tried hard coding the find text and replacement text instead of having the user input it and it still didn't work.

What am I doing wrong here?
==================================
Public Function FindAndReplace()
On Error GoTo FindAndReplace_Err

Dim callWordMerge As Variant
Dim appWord As New Word.Application
Dim doc As Word.Document
Dim rst As ADODB.Recordset
Dim DB As Database
Dim RS As Recordset
Dim vPath As String
Dim vDoc As String
Dim vFullPath As String
Dim strReplaceText As String
Dim strFindText As String

On Error Resume Next

Set DB = CurrentDb()
Set RS = DB.OpenRecordset("FindDocument&quot
Set appWord = GetObject(, "Word.application&quot
If Err = 429 Then
Set appWord = New Word.Application
Err = 0
End If

RS.MoveFirst
Do Until RS.EOF
Set rst = Nothing
Set doc = Nothing
Set appWord = Nothing
vPath = RS("Path&quot
vDoc = RS("Document&quot
vFullPath = vPath & vDoc
With appWord
Set doc = .Documents(vDoc)
If Err = 0 Then
If MsgBox("Do you want to save the current document before updating the data?", vbYesNo) = vbYes Then
.Dialogs(wdDialogFileSaveAs).Show
End If
doc.Close False
End If

Set doc = .Documents.Open(vFullPath, , True)
Set rst = New ADODB.Recordset

appWord.Documents.Open vFullPath
appWord.Visible = True

With doc
strFindText = InputBox("type find text&quot
strReplaceText = InputBox("type replace text&quot

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = strFindText
.Replacement.Text = strReplaceText
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End With
.Visible = True
.Activate
End With

RS.MoveNext
Loop

vPath = ""

RS.Close
DB.Close

Beep
MsgBox "Complete!"
Err.Clear

FindAndReplace_Exit:
Exit Function

FindAndReplace_Err:
MsgBox Err.Description
End Function

 

[B827]

I don't know if this will help but this code will run a Macro in an Excel Workbook from Access.

XLApp.workbooks.Open FileName
f = RunMacro("FormatFont&quot

 

[kramerica]

Try this:

This is a VB Function for Access that will find and replace text. It works GREAT!

Public Function MyReplace(strOrig As String, strOld As String, strNew As String)
Dim intAt As Integer, strAltered As String
If IsNull(strOrig) Or IsNull(strOld) Or IsNull(strNew) Then
msgbox "Need String To search, plus Old and New Values", vbInformation, "Need Additional Info"
Else
For intAt = 1 To Len(strOrig)
If Mid(strOrig, intAt, Len(strOld)) = strOld Then
strAltered = strAltered & strNew
intAt = intAt + (Len(strOld) - 1)
Else
strAltered = strAltered & Mid(strOrig, intAt, 1)
End If
Next intAt
End If
MyReplace = strAltered
End Function

Good luck!,
Kramerica

 

[trueharted]

B827,

Good idea. I'll look at that.



kramerica,

Isn't your code to find and replace within Access? How would you rewrite it to find and replace within Word, but programmed in Access?

I need to write the code in Access but execute it for/in Word. I have a user who has approx. 300 Word documents that she needs to do the same find and replace for and she wants a shortcut rather than opening all 300 docs and doing it manually.

 

[trueharted]

B827,

With your suggestion, I was able to take a different approach, which worked. For anybody who may be interested, the following is the code I ended up with in my Access module:

Public Function FindAndReplace()
On Error GoTo FindAndReplace_Err

Dim callWordMerge As Variant
Dim appWord As New Word.Application
Dim doc As Word.Document
Dim rst As ADODB.Recordset
Dim DB As Database
Dim RS As Recordset
Dim vPath As String
Dim vDoc As String
Dim vFullPath As String
Dim strReplaceText As String
Dim strFindText As String

On Error Resume Next

Set DB = CurrentDb()
Set RS = DB.OpenRecordset("FindDocument&quot
Set appWord = GetObject(, "Word.application&quot
If Err = 429 Then
Set appWord = New Word.Application
Err = 0
End If

RS.MoveFirst
Do Until RS.EOF
Set rst = Nothing
Set doc = Nothing
Set appWord = Nothing
vPath = RS("Path&quot
vDoc = RS("Document&quot
vFullPath = vPath & vDoc
With appWord
Set doc = appWord.Documents.Open(vFullPath, , False)
Set rst = New ADODB.Recordset
appWord.Visible = True
appWord.Activate
appWord.Run "findreplace"
End With
RS.MoveNext
Loop

vPath = ""

RS.Close
DB.Close

Beep
MsgBox "Complete!"
Err.Clear

FindAndReplace_Exit:
Exit Function

FindAndReplace_Err:
MsgBox Err.Description
End Function

---------------------

The following was the macro I created in Word:

Sub findreplace()
'
' findreplace Macro
' Macro recorded 3/12/2002 by gricks
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "dog"
.Replacement.Text = "turkey"
.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
Application.Quit
End Sub


It works like a charm! If anybody wants a copy of the Access file, I'd be glad to share. If several people want a copy, maybe someone with a website would be willing to post it. I don't have one...yet.

My email address is gricks_2001@yahoo.com. (That's an underscore, not a space.)

Happy programming!

 

[trueharted]

Note:

I changed the error handler to read:

FindAndReplace_Err:
If (Err = 2302) Then
MsgBox "Path: " & "'" & vPath & "'" & _
" is no longer valid. Please revise table.", vbOKOnly
Else
MsgBox Err.Description
End If
Resume Next

This way it tells the user if a file in the table the code loops through is not valid.

 

[B827]

Gricks - Nice.

I'll have a copy for future reference. Sandy

 

[lxn]

In case anyone's interested, here's some sample code concerning Word and VB, I found some of them quite useful.

http://www.jojo-zawawi.com/code-samples-pages/code-samples.htm

Merlin

 

[Guest_imported]

I have about 1,000 Word documents in directory, and I need to write code in Access 97 to find text string in the documents.
I can't use with MS Windows finder, because I need to refine the path of documents (The user not know where are the documents).

May somebody help me?

thx

 

[B827]

Does the text string appear only once, and is it in every document or is the problem finding which document the text is in? Sandy

 

[Guest_imported]

I need to receive list of the name of the files which include the string at least one time.
If I click on name file it will be open, and will bold the string.

If you have any example I will apriciate you very much.

Tank you very much for the effort.

(Sorry about the english)

 

[B827]

Hi Koren,
don't worry about the English - it's pretty good. If you post your E-Mail address I'll send you something which was the result of this Thread and should help you do what you want. Sandy

 

[Guest_imported]

Dir Sandy,
My Email is: ezrakoren@hotmail.com

Thank again,
Koren

 

[ryan1]

gricks,
i have a question. I coyped the mod into my database and ran the FindandReplace function and got an error that read(compile error: user - defined type not defined) then it highlights this "Dim rst As ADODB.Recordset" any ideas and help would be appreciated. Thanks!

 

[Hasse]

sbutler,
chances are low but you never know:
What's your office version? In office 97, for example, the recordset needs to be declared otherwise: "Dim rst as adodb.recordset".
Otherwise, be sure having checked the right references (VB editor - extra - references).
Hasse

ps CAN SOMEONE SEND ME(hans_vanmechelen@myfastmail.com) A COPY OF THE CODE? I tried contacting gricks, but he seems having left his yahoo spot for a while...
My purpose: I'll try to modify & combine it in a way to (next week *<| ) (1) control a list of > 1200 word documents, arranged in > 200 groups, to check if they correspond to a certain proposed template (2) copy-paste parts of their contents to new documents.

 

[trueharted]

I applogize to anybody who has tried to contact me this week. I've been away at training for a new conversion project. I will get back to each of you as I can as soon as I've caught up on a week's worth of emails and phone messages. Thanks for your patience.

P.S. I'm a she not a he.

gricks

 

[Hasse]

CORRECTION on my previous post: of course
in office 97 the recordset declaration should be: &quot;Dim rst as recordset&quot;
in office 2000 the recordset declaration could be: &quot;Dim rst as ado.recordset&quot; depending on the reference set

(feel free to red flag this post if I'm wrong - in order not to load this thread too heavy)
ps gricks: Sandy sent me (rhyme!) the code... I'll keep you informed about any possibly useful changes...

 

[Hasse]

Except for a minor error, I adapted Gricks' application to an Office 97 for PC's with no common dialog installed. (I replaced the dialog for an input box, restored the appropriate VBA references,...). When it entirely works as I want it to, I'll let you know.
Hasse

 

[Hasse]

Dear contributors to this thread,

I posted a new problem which builds further on your issue at:

Home > Forums > Programmers > DBMS Packages > Microsoft: Access Modules (VBA Coding) Forum
Pass argument(s) to Word macro, e.g. for merging to separate documents
thread705-373071

Please feel free to read & participate, if it interests you. I hope it'll be of some use for others as well, when the job is done...

Hans

 

[Hasse]

UPDATE
I used the application for batch processing hundreds of Word documents for other purposes than find-replace too & it works great (printing in a custom order (using a query), applying standard layout,...).

1. I did some changes for use in Access 97:
- replacement of Custom Dialog ActiveX control (as we have no Administrator rights at our office) by an inputbox. Path input remains user (almost) 'friendly' by using freeware rjhExtensions (explorer - right click - path to clipboard => paste in input box).
- extra form text box: custom (max) number of files to be processed at once
- extra form option: (don't) delete files after processing
(+ extra table field 'done' = boolean)

2. I used the application too for providing each document with a custom footer. Here's the code, as it might be of some use for others too...

Public Sub FindReplace()

Dim myRange, tmpRange As Range

'Insert table in footer
Set myRange = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
myRange.Delete
Set tmpRange = myRange
myRange.Tables.Add tmpRange, 1, 3

'Make table borders invisible
myRange.Tables(1).Borders.OutsideLineStyle = wdLineStyleNone

'Insert file name field in column 1
Set tmpRange = myRange.Tables(1).Columns(1).Cells(1).Range '.Duplicate
tmpRange.Move Unit:=wdCharacter, Count:=-1
tmpRange.Fields.Add tmpRange, wdFieldFileName

'Insert fields & text &quot;Pg.x/y&quot; in column 2
Set tmpRange = myRange.Tables(1).Columns(2).Cells(1).Range '.Duplicate
tmpRange.Move Unit:=wdCharacter, Count:=-1
tmpRange.Fields.Add tmpRange, wdFieldSectionPages
tmpRange.InsertBefore &quot;/&quot;
tmpRange.SetRange myRange.Tables(1).Columns(2).Cells(1).Range.Start, myRange.Tables(1).Columns(2).Cells(1).Range.Start
tmpRange.Fields.Add tmpRange, wdFieldPage
tmpRange.InsertBefore &quot;Pg.&quot;

'Insert date last saved field in column 3
Set tmpRange = myRange.Tables(1).Columns(3).Cells(1).Range
tmpRange.Move Unit:=wdCharacter, Count:=-1
tmpRange.Fields.Add tmpRange, wdFieldEmpty, &quot;SAVEDATE \@ &quot;&quot;dd/MM/yy&quot;&quot;&quot;, PreserveFormatting:=True

'Update fields
ActiveDocument.Fields.Update

End Sub

FYI: I only use the RANGE object as I'll probably hide the Word application to speed up the processing and I've read (!?) that the SELECTION object might not work in these circumstances.