Adding text to hundreds of Word documents 1

[johncurtis]

Hi all,

I have someone who has created hundreds of word 97 documents and now wants to add some text to each one. The text will be the same for each document (a link and copyright notice.) She would also like the text automatically added to any new documents she creates.
Is there an easier way to do this than opening each document and pasting the text in? I guess it could be done with a macro but I don't know much about them. Can you run a macro on multiple documents without opening each one individually?

Thanks in advance for any help
John

 

[Dreamboat]

This might lead you to some help:

http://www.mvps.org/word/FAQs/MacrosVBA/BatchFR.htm

If there is already something in the location that you're placing this text (like the footer), you could find the footer text and replace it with your text.

At very least, this should contain the code you need to loop through documents. You may need to change the code to suit your needs. Here's the code:

Option Explicit

Public Sub BatchReplaceAll()

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long

PathToUse = "C:\Test\"

'Error handler to handle error generated whenever
'the FindReplace dialog is closed

On Error Resume Next

'Close all open documents before beginning

Documents.Close SaveChanges:=wdPromptToSaveChanges

'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document

FirstLoop = True

'Set the directory and type of file to batch process

myFile = Dir$(PathToUse & "*.doc&quot

While myFile <> &quot;&quot;

'Open document
Set myDoc = Documents.Open(PathToUse & myFile)

If FirstLoop Then

'Display dialog on first loop only

Dialogs(wdDialogEditReplace).Show

FirstLoop = False

Response = MsgBox(&quot;Do you want to process &quot; & _
&quot;the rest of the files in this folder&quot;, vbYesNo)
If Response = vbNo Then Exit Sub

Else

'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again

With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With

End If

'Close the modified document after saving changes

myDoc.Close SaveChanges:=wdSaveChanges

'Next file in folder

myFile = Dir$()

Wend

End Sub



You don't need the message box part either.

http://www.PiersonTech.com

techsupportgirl@home.com
Brainbench MVP for Microsoft Word

 

[johncurtis]

Thanks Dreamboat, that's very helpful. I'll try and modify the code and post back if I have any problems (I'm sure I will!)

John

 

[johncurtis]

I've modified the code and I now have a macro that loops through all the files in a folder and adds text into the footer. I have a couple of further questions for you experts:

We would prefer the text only to appear in the footer of the last page. I know this can be done by inserting a section break in the second last page but the documents are quite complicated with graphics etc and I'm worried that this could have strange effects. Is there any other way to do this?

The text contains a hyperlink which works fine when in the body of the document but won't work when in the footer. Will links work in a footer and if so how is it done?

Thanks
John

 

[Dreamboat]

If you want my opinion on this one (well, even if you don't...):

Create a textbox in a document, go ahead and type the link in the textbox, but then just make the whole dern textbox the hyperlink. Select the textbox and create an autotext entry for it.

Create your code to go to the end of the document and insert the autotext, which looks something like:

Selection.EndKey Unit:=wdStory
Application.DisplayAutoCompleteTips = True
NormalTemplate.AutoTextEntries(&quot;textbox&quot.Insert _
Where:=Selection.Range

The Tip shows the address of the hyperlink, which you may or may not want to show.

http://www.PiersonTech.com

techsupportgirl@home.com
Brainbench MVP for Microsoft Word

 

[johncurtis]

Dreamboat, I thought about putting the copyright notice and link at the end of the document rather than in the footer. The problem is that most of the documents have been formatted to fit on an exact number of pages so any added text would appear on its own on a new page. We've decided (with a bit of persuasion from me) to leave the text in the footer of each page. The documents are going on our web site so if anyone prints out individual pages from a document the copyright notice will still be there.

I'll post the hyperlink question separately.

Thanks again for your help - you're a star!

For anyone interested, the modified code I've used is posted below

John

Public Sub Batch_Add_Footer()

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long

PathToUse = &quot;d:\test\&quot;

'Error handler to handle error generated whenever
'the FindReplace dialog is closed

On Error Resume Next

'Close all open documents before beginning

Documents.Close SaveChanges:=wdPromptToSaveChanges

'Set the directory and type of file to batch process

myFile = Dir$(PathToUse & &quot;*.doc&quot

While myFile <> &quot;&quot;

'Open document
Set myDoc = Documents.Open(PathToUse & myFile)

'Open footer

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If

'Change Font

Selection.Font.Name = &quot;Arial&quot;
Selection.Font.Size = 11

'Put text in Footer

Selection.TypeText Text:=&quot;My Footer&quot;
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'Close the modified document after saving changes

myDoc.Close SaveChanges:=wdSaveChanges

'Next file in folder

myFile = Dir$()

Wend

End Sub