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.