View Single Post
 
Old 01-30-2018, 06:24 PM
vincenzo345 vincenzo345 is offline Windows 7 64bit Office 2016
Novice
 
Join Date: Aug 2017
Posts: 13
vincenzo345 is on a distinguished road
Default Combining documents loses footer info.

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
If anyone can help me understand whats causing the issues with bringing the footer correctly into the combined documents, i would greatly appreciate it.
Reply With Quote