[VBA] Tách mỗi trang văn bản thành 1 file riêng biệt

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dao Dinh Ngoc - THPT Nguyen Binh Khiem, Chu Se, Gia Lai      '
' Update 28/6/2020                                             '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim rCopy As Range
Dim rCurrent As Range
Dim f_name As String
Dim i As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim np As Integer
Function DirExists(file_test As String)
 Dim fs
 Set fs = CreateObject("Scripting.FileSystemObject")
 DirExists = fs.folderexists(file_test)
End Function
'Đặt lề trên, dưới, trái phải 1 cm
Sub Fix_Le(fx As String)
    With ActiveDocument.PageSetup
        .TopMargin = CentimetersToPoints(1)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(1)
        .RightMargin = CentimetersToPoints(1)
    End With
End Sub
'
Sub mrDao_split_page(control As IRibbonControl)
Dim idx As Long
   Application.ScreenUpdating = False
    Set rCurrent = Selection.Range
    np = ActiveDocument.Range.Information(wdNumberOfPagesInDocument) 'Lấy số trang của văn bản
    f_name = ActiveDocument.Path & "\MrDao_Kq" 'Đường dẫn thưc mục lưu kết quả tách
    
    If DirExists(f_name) = False Then
       MkDir (f_name) ' Tạo thư mục lưu kết quả
    End If
     
    For idx = 1 To np
        Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _
        Which:=wdGoToAbsolute, Count:=idx)
         Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, _
          Count:=idx
        rCopy.End = Selection.Bookmarks("\Page").Range.End
        If rCopy <> "" Then
          ' Sao chép từng trang
            rCopy.Copy
            Documents.Add 'Tạo 1 văn bản mới
           ' Dán dữ liệu giữ nguyên định dạng
            ActiveDocument.Range.PasteAndFormat (wdFormatOriginalFormatting)
            Fix_Le (ActiveDocument) 'Fix lề mỗi file 1cm
           ' Lưu tên file vào thư mục
            ActiveDocument.SaveAs2 FileName:=f_name & "\file_" & Str(idx) & ".docx"
            ActiveDocument.Close
         End If
         rCurrent.Select
   Next idx
    Application.Assistant.DoAlert "Thông báo", ChrW(272) & "ã th" & ChrW(7921) & "c hi" & ChrW( _
        7879) & "n xong!", 0, 4, 0, 0, 0
   Application.ScreenUpdating = True
End Sub