 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Word / Mailmerge and Fax / December 2004Copying a letter header into a mailmerge template
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 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.  SignaturePlease 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 > 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 [quoted text clipped - 15 lines] > > 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 > The macro in the article ?Find & ReplaceAll on a batch of documents in the > same folder? at: [quoted text clipped - 26 lines] >> >> 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 > 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 [quoted text clipped - 38 lines] >>> >>> dixie 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 SignaturePlease 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 > 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 [quoted text clipped - 45 lines] > >>> > >>> dixie |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.