Copying a letter header into a mailmerge template

[dixie]

I am doing a job where I need to copy a letter header into each of about 100
letters which are mailmerge template documents for about 20 different
customers - all up about 2000 copy and pastes requiring opening each
document and deleting the current header and pasting the new one. I have
tried to use IncludeText to do this and having the header in a file, but it
appears that the client must open each letter and refresh the link before
they can get the header in the letter.

Is there a way of doing what I am trying to do without me doing this
mindless copy and paste operation which takes about 1 hour for each client
and is totally boring and therefore prone to me making mistakes.

Can a simple little program be written that will take a lump of text out of
one document and just paste it into a series of documents or just paste the
contents of the clipboard into the top of a document?

Any suggestions please.

dixie

 

[Doug Robbins - Word MVP]

The macro in the article “Find & ReplaceAll on a batch of documents in the
same folder” at:

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

could be modified to do what you want.
--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[dixie]

Thanks Doug that does look promising. I followed the instructions however
and created a global template with that code in it and now, when I go to the
first document in the folder I wish to do the universal substitution in and
select the macro, I just get an error message that says "Compile error in
hidden module: ThisDocument". I have read the help, but it does not! Have
you any ideas?

dixie

 

[dixie]

Dont worry with the last message - found I had included two lines of text in
the module. It does work with text replacements, unfortunately, it won't
work for me as it is not capable of replacing the graphic in the letter
head. Blast, I got so excited about that.

dixie

 

[Doug Robbins - Word MVP]

You will need to modify the macro with some more specific code to handle the
graphics. There is no doubt however that it can be done. Here's a
procedure from a project that I created at one time that does that sort of
thing (it too however will need to be modifed for your situation):

Sub UpdateDocs()
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
'Insert logo if the file has been selected
If InStr(txtLargeLogoPath, ":") > 0 Then
If myDoc.Sections.Count > 1 And Not myDoc.Name = "FRM-701.doc" Then
'Insert Logo on Title Page

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
' Adjust size of logo to match avalable space
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight < InchesToPoints(2) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(2)
.Width = owidth * InchesToPoints(2) / oheight
End With
End If
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth > InchesToPoints(2.85) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Width = InchesToPoints(2.85)
.Height = oheight * InchesToPoints(2.85) / owidth
End With
End If
'Insert Logo into all the Headers in the Document
For i = 2 To myDoc.Sections.Count

myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight > InchesToPoints(0.68) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
If oheight < InchesToPoints(0.68) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
oheight =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If owidth > InchesToPoints(0.98) Then
With
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Width = InchesToPoints(0.98)
.Height = oheight * InchesToPoints(0.98) / owidth
End With
End If
Next i
Else
'Insert Logo into Section 1 Header

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight > InchesToPoints(0.68) Then
With
myDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
If UCase(myDoc.Name) = "FRM-701.DOC" Then 'Special Case
document
'Insert Logo into Section 2 Header

myDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.Delete

myDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes.AddPicture Filename:=txtLargeLogoPath
'Re-size logo
oheight =
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Height
owidth =
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1).Width
If oheight > InchesToPoints(0.68) Then
With
myDoc.Sections(2).Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1,
1).Range.InlineShapes(1)
.Height = InchesToPoints(0.68)
.Width = owidth * InchesToPoints(0.68) / oheight
End With
End If
End If
End If
End If
'Create Document Variables
myDoc.Variables("vissue").Value = 1
myDoc.Variables("vrevision").Value = 0
myDoc.Variables("vDocDate").Value = Format(vIssueDate, "MMMM dd, yyyy")
myDoc.Variables("vRevDate").Value = Format(vIssueDate, "MMM dd, yyyy")
myDoc.Variables("vreviewer").Value = txtReviewer
myDoc.Variables("vapprover").Value = txtApprover
myDoc.Variables("vcompanyname").Value = txtCompanyName
myDoc.Variables("vstreetaddress").Value = txtStreetAddress
myDoc.Variables("vcity").Value = txtCity
myDoc.Variables("vstateprovince").Value = comboProvinceorState.Value
myDoc.Variables("vcountry").Value = comboCountry.Value
myDoc.Variables("vpostcodezip").Value = txtPostalorZipCode
myDoc.Variables("vqualityreptitle").Value = txtQualityRepTitle
myDoc.Variables("vphone").Value = txtPhone
myDoc.Variables("vfax").Value = txtFax
myDoc.Variables("vmanagername").Value = txtSeniorManagerName
myDoc.Variables("vmanagertitle").Value = txtSeniorManagerTitle
myDoc.Variables("vqualityrepname").Value = txtQualityRepName
'Update the fields in the document to display the values inserted into the
variables
myDoc.Fields.Update
For i = 1 To myDoc.Sections.Count
myDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields.Update
Next i
'Save and Close
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP