Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-30-2018, 06:24 PM
vincenzo345 vincenzo345 is offline Combining documents loses footer info. Windows 7 64bit Combining documents loses footer info. Office 2016
Novice
Combining documents loses footer info.
 
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
  #2  
Old 01-30-2018, 07:27 PM
macropod's Avatar
macropod macropod is offline Combining documents loses footer info. Windows 7 64bit Combining documents loses footer info. Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

It's hardly surprising you're not getting the correct footer content. You've deleted the code that inserts it.

As for your barcodes, if they're being inserted into the header/footer via a bookmark cross-reference, and all the source documents use the same bookmark, only one of each bookmark will survive and all the cross-references will point to that. The workaround would be to apply a unique Style name to the barcode pairs in the document body (i.e. one Style for the customer ID, and another Style for the document ID), then use two StyleRef fieldd in the header/footer, referencing those Styles.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 01-31-2018, 07:42 AM
vincenzo345 vincenzo345 is offline Combining documents loses footer info. Windows 7 64bit Combining documents loses footer info. Office 2016
Novice
Combining documents loses footer info.
 
Join Date: Aug 2017
Posts: 13
vincenzo345 is on a distinguished road
Default

Thanks for the help. If I dont delete the code that you mentioned, then the first document that gets combined never gets a footer.

The entire footer is an INCLUDETEXT field which refferences our "footer" document. That document has "{MERGEFIELD 1} Company Name {MERGEFIELD 2}" and then our contact info on a second line.

Since it is a book mark, it sounds like the first book mark is surviving.
I'm unclear on what youre suggesting. It sounds like if I were to remove the bookmark and hardcode the footer on each document then it should work fine. Please correct me if I'm wrong. However, in the mean time I will try this and a few other things. I may come back to ask about your suggested workaround in more detail because I dont fully understand what you mean or how to do that.
Reply With Quote
  #4  
Old 01-31-2018, 01:38 PM
macropod's Avatar
macropod macropod is offline Combining documents loses footer info. Windows 7 64bit Combining documents loses footer info. Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Try changing:
Code:
                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
to:
Code:
                With Rng  
                    .Collapse wdCollapseEnd 
                    .InsertBreak Type:=wdSectionBreakNextPage 
                    .Collapse wdCollapseEnd 
                    Call LayoutTransfer(DocSrc, DocTgt) 
                    .FormattedText = DocSrc.Range.FormattedText
                End With
and reinstating:
Code:
                For Each HdFt In .Sections(.Sections.Count - 1).Footers 
                    With HdFt.Range 
                        .FormattedText = DocSrc.Sections.Last. Footers(HdFt.Index).Range.FormattedText 
                        .Characters.Last.Delete 
                    End With 
                Next
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Tags
combine, documents, footer

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Combining documents loses footer info. combining word documents jesselscott Word 1 04-28-2015 09:55 AM
Combining documents loses footer info. Combining Footer Sections williams Word 6 03-04-2015 09:43 AM
Combining/merging documents hawkeyefxr Word 11 08-03-2012 03:01 AM
Combining documents loses footer info. Combining documents of different formats Blaie Word 1 06-04-2011 06:35 PM
Combining documents loses footer info. Combining Word Documents dms997 Word 5 02-26-2011 03:25 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:35 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft