Option Explicit

Sub MergeFilesInAFolderlntoOneDoc()
Dim dlgFile As FileDialog
Dim wdApp As Object, oRng As Object
Dim objDoc As Object, objNewDoc As Object
Dim StrFolder As String, strFile As String
    Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker)

    With dlgFile
        If .Show = -1 Then
            StrFolder = dlgFile.SelectedItems.Item(1) & Chr(92)
        Else
            MsgBox ("No folder is selected!")
            Exit Sub
        End If
    End With

    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    strFile = Dir(StrFolder & "*.docx", vbNormal)
    With wdApp
        .Visible = True
        Set objNewDoc = .Documents.Add
        While strFile <> ""
            Set objDoc = .Documents.Open(FileName:=StrFolder & strFile)
            With objNewDoc
                Set oRng = .Range
                If Len(oRng) > 1 Then
                    oRng.Collapse 0
                    oRng.InsertBreak 7
                End If
                oRng.Collapse 0
                oRng.FormattedText = objDoc.Range.FormattedText
                objDoc.Close 0
            End With
            DoEvents
            strFile = Dir()
        Wend
        objNewDoc.Activate
    End With
End Sub