Skip to content

Instantly share code, notes, and snippets.

@ap-Codkelden

ap-Codkelden/merge_docs.vba

Created October 10, 2020 10:01
Show Gist options
  • Save ap-Codkelden/a8ff9bfae913f3d3092e874f96ec5784 to your computer and use it in GitHub Desktop.
Save ap-Codkelden/a8ff9bfae913f3d3092e874f96ec5784 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. ap-Codkelden created this gist Oct 10, 2020.
    39 changes: 39 additions & 0 deletions merge_docs.vba
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,39 @@
    Sub MergeDocs()
    On Error GoTo ErrorHandler
    Dim rng As Range
    Dim MainDoc As Document
    Dim strFile As String, strFolder As String
    Dim Count As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Selectos"
    .AllowMultiSelect = False
    If .Show Then
    strFolder = .SelectedItems(1) & Application.PathSeparator
    Else
    Exit Sub
    End If
    End With
    Set MainDoc = Documents.Add
    strFile = Dir$(strFolder & "*.doc*") ' 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 wdPageBreak ' 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
    ErrorHandler:
    MsgBox (strFile)
    Resume Next
    End Sub