Help debugging a Macro that merges individual word docs into one document

[vincenzo345]

So, I have this macro which sucessfully merges multiple word documents in a directory into one word doc. It works great but has a few issues.



Issue 1

The documents im merging vary in size. Some are letter and others are legal size. The page sizes dont transfer exactly as they should into the merged document.

Issue 2

There appear to be formatting issues, mainly with fonts and im not sure how to go about fixing this. there is one {INCLUDETEXT ""} field that contains a table and the font in the table always defaults to Calibri size 11.

Im at a loss on how to resolve these issues. So, any help is greatly appreciated.

 
 
Sub MergeDocsInFolder()
    Dim rng As Range
    Dim MainDoc As Document
    Dim strFile As String, strFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Pick folder"
        .AllowMultiSelect = False
        If .Show Then
            strFolder = .SelectedItems(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
    End With
    Set MainDoc = Documents.Add
    strFile = Dir$(strFolder & "*.docx") ' can change to .docx
    Count = 0
    Do Until strFile = ""
        Count = Count + 1
        Set rng = MainDoc.Range
        With rng
            .Collapse wdCollapseEnd
            If Count > 1 Then
                .InsertBreak wdSectionBreakNextPage
                .End = MainDoc.Range.End
                .Collapse wdCollapseEnd
            End If
            .InsertFile strFolder & strFile
        End With
        strFile = Dir$()
    Loop
    MsgBox ("Files are merged")
lbl_Exit:
    Exit Sub
End Sub