ادغام چند فایل ورد

[mazoolagh]

Private Sub BTN_APPEND_Click()

On Error GoTo Error_Handler

Dim i, n As Integer

n = Me.DocumentsList.ListCount

If n = 0 Then

    v = MsgBox("Select Documents", vbExclamation, "")

    Exit Sub

End If

InProgress = True

Canceled = False

Me.BTN_CANCEL.Visible = True

Dim WordApp As New Word.Application

Dim Doc As Word.Document

Set Doc = WordApp.Documents.Add

Dim file

v = SysCmd(acSysCmdClearStatus)

For i = 1 To n

    file = Me.DocumentsList.ItemData(i - 1)

    v = SysCmd(acSysCmdSetStatus, "Adding " & i & " of " & n & " : " & file)

    DoEvents

    If Canceled Then

        If MsgBox("Cancel Operation?", vbQuestion + vbYesNo, "") = vbYes Then

            v = SysCmd(acSysCmdClearStatus)

            Me.BTN_ADD_FILES.SetFocus

            Me.BTN_CANCEL.Visible = False

            Exit Sub

        Else

            Canceled = False

        End If

    End If

    WordApp.Selection.InsertFile file

Next i

v = SysCmd(acSysCmdSetStatus, "Saving File ...")

Doc.SaveAs Me.DestinationFolder & "" & Me.FileName & ".docx"

Doc.Close

WordApp.Quit wdSaveChanges

Me.BTN_ADD_FILES.SetFocus

Me.BTN_CANCEL.Visible = False

v = SysCmd(acSysCmdClearStatus)

v = MsgBox("Document saved successfully," & vbCrLf & "Do you want to open it?", vbYesNo + vbInformation, "")

If v = vbYes Then

    Application.FollowHyperlink Me.DestinationFolder & "" & Me.FileName & ".docx"

End If

Exit Sub

Error_Handler:

v = SysCmd(acSysCmdClearStatus)

v = MsgBox(Err.Description, vbCritical, "Error " & Err.Number)

Me.BTN_ADD_FILES.SetFocus

Me.BTN_CANCEL.Visible = False

End Sub





Private Sub BTN_CANCEL_Click()

Canceled = True

End Sub