![]() |
#1
|
|||
|
|||
![]()
I'm having difficulty with a macro. The macro looks into a folder and combines all of the word documents in that folder location into one document. The issue I'm having is when the documents are combined, the footer doesnt get combined into each document properly.
The footer margin is increased due to spaces added under the text during combining. Additionally, the footer contents from the first combined document has a tendency to be replicated in the footers of the other combined documents. The footers I'm having issues with have barcodes with mergefield data. 1 barcode to identify the customer ID [field 2], and a second to identify the document [field 1]. So, It is important that the footer data integrity stay intact. The macro that im using is a modified version of somthing Macropod created. That Macro can be found here: http://www.vbaexpress.com/forum/show...word-doc/page2 The Reason I had to modify the code was because the footer wouldnt combine with the first document. The first document never had a footer. The Modified Macro is here: Code:
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 Sub MergeDocuments() Application.ScreenUpdating = False Application.DisplayAlerts = wdAlertsNone Dim strFolder As String, strFile As String Dim DocSrc As Document, DocTgt As Document Dim strDocNm As String, Rng As Range, HdFt As HeaderFooter strFolder = GetFolder If strFolder = "" Then Exit Sub Set DocTgt = ActiveDocument strDocNm = DocTgt.FullName strFile = Dir(strFolder & "\*.docx") While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set DocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With DocTgt Set Rng = .Range.Characters.Last With Rng .Collapse wdCollapseEnd Call LayoutTransfer(DocSrc, DocTgt) .FormattedText = DocSrc.Range.FormattedText .Collapse wdCollapseEnd '.Fields.Add Range:=Rng.Sections(-1).Footers(wdHeaderFooterPrimary).Range., Type:=wdFieldEmpty, Text:="INCLUDETEXT &""C:\\MERGEDOCS\\01_All\\Footer.docx""," '.InsertBreak Type:=wdSectionBreakNextPage End With For Each HdFt In .Sections.Last.Headers HdFt.LinkToPrevious = False Next For Each HdFt In .Sections.Last.Footers HdFt.LinkToPrevious = False Next For Each HdFt In .Sections(.Sections.Count).Headers With HdFt.Range .FormattedText = DocSrc.Sections.Last.Headers(HdFt.Index).Range.FormattedText .Characters.Last.Delete End With Next End With DocSrc.Close False End If strFile = Dir() Wend Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing Application.DisplayAlerts = wdAlertsAll Application.ScreenUpdating = True End Sub Sub LayoutTransfer1(DocSrc As Document, DocTgt As Document) 'Document Body variables Dim sPageHght As Single, sPageWdth As Single Dim sHeaderDist As Single, sFooterDist As Single Dim sTMargin As Single, sBMargin As Single Dim sLMargin As Single, sRMargin As Single Dim sGutter As Single, sGutterPos As Single Dim lPaperSize As Long, lGutterStyle As Long Dim lMirrorMargins As Long, lVerticalAlignment As Long Dim lScnStart As Long, lScnDir As Long Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean Dim bOrientation As Boolean 'Get Page Setup parameters With DocSrc.Sections.First.PageSetup lPaperSize = .PaperSize lGutterStyle = .GutterStyle bOrientation = .Orientation lMirrorMargins = .MirrorMargins lScnStart = .SectionStart lScnDir = .SectionDirection lOddEvenHdFt = .OddAndEvenPagesHeaderFooter lDiffFirstHdFt = .DifferentFirstPageHeaderFooter lVerticalAlignment = .VerticalAlignment sPageHght = .PageHeight sPageWdth = .PageWidth sTMargin = .TopMargin sBMargin = .BottomMargin sLMargin = .LeftMargin sRMargin = .RightMargin sGutter = .Gutter sGutterPos = .GutterPos sHeaderDist = .HeaderDistance sFooterDist = .FooterDistance bTwoPagesOnOne = .TwoPagesOnOne bBkFldPrnt = .BookFoldPrinting bBkFldPrnShts = .BookFoldPrintingSheets bBkFldRevPrnt = .BookFoldRevPrinting End With 'Set Page Setup parameters With DocTgt.Sections.Last.PageSetup .GutterStyle = lGutterStyle .MirrorMargins = lMirrorMargins .SectionStart = lScnStart .SectionDirection = lScnDir .OddAndEvenPagesHeaderFooter = lOddEvenHdFt .DifferentFirstPageHeaderFooter = lDiffFirstHdFt .VerticalAlignment = lVerticalAlignment .PageHeight = sPageHght .PageWidth = sPageWdth .TopMargin = sTMargin .BottomMargin = sBMargin .LeftMargin = sLMargin .RightMargin = sRMargin .Gutter = sGutter .GutterPos = sGutterPos .HeaderDistance = sHeaderDist .FooterDistance = sFooterDist .TwoPagesOnOne = bTwoPagesOnOne .BookFoldPrinting = bBkFldPrnt .BookFoldPrintingSheets = bBkFldPrnShts .BookFoldRevPrinting = bBkFldRevPrnt .PaperSize = lPaperSize .Orientation = bOrientation End With End Sub |
Tags |
combine, documents, footer |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
jesselscott | Word | 1 | 04-28-2015 09:55 AM |
![]() |
williams | Word | 6 | 03-04-2015 09:43 AM |
Combining/merging documents | hawkeyefxr | Word | 11 | 08-03-2012 03:01 AM |
![]() |
Blaie | Word | 1 | 06-04-2011 06:35 PM |
![]() |
dms997 | Word | 5 | 02-26-2011 03:25 AM |