Vba 通过FileDialogbox选择器将文档内容复制到新文档

使用MS_Word 2010，我一直在尝试实现将一个文件的所有内容复制到一个新文件的方法，检索原始文件的文件名并将其添加到带有后缀“copy”的新文件中

所有这些过程都是有原因的，因为原始文档只有几个可编辑部分，并且启用了保护功能，我无法禁用它，但我需要使用其他宏对其进行检查，因此通过新文档中内容的副本，我可以应用我的整个宏。我也知道CopyFile方法，但由于该方法同时复制了原始文档的特征以及编辑中的约束，我决定不使用它

搜索并使用记录器进行复制操作，我已经能够提供以下内容：

Sub Backup()
Dim DocName As String
Dim DocPath As String

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Declare a variable to contain the path of each selected item. Even though the path is aString, the variable must be a Variant because For Each...Next,  routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

    'Allow the user to select multiple files.
    .AllowMultiSelect = True

    'Use the Show method to display the File Picker dialog box and return the user's action.
    'If the user presses the button...
    If .Show = -1 Then
        'Step through each string in the FileDialogSelectedItems collection.
        For Each vrtSelectedItem In .SelectedItems
        On Error Resume Next

            'vrtSelectedItem is aString that contains the path of each selected item. You can use any file I/O functions that you want to work with this path.
            'MsgBox "Selected item's path: " & vrtSelectedItem

            'Retrieve the name of the current doc (later I found out about .Name, .Path, .FullName ...)
            Dim fso
            Set fso = CreateObject("Scripting.FileSystemObject")
            DocName = fso.GetBaseName(vrtSelectedItem)
            'MsgBox "Selected item's : " & DocName

            'Retrieve the path without the filename/extention
            Documents.Open(vrtSelectedItem).Active
            DocPath = ActiveDocument.Path
            'MsgBox "Selected item's path: " & DocPath

            'Copy the content of the current document
            'With Documents(DocName)
            With ActiveDocument
                .WholeStory
                .Copy
            End With

            'Create Backup File with ability to modify it, since the original is protected by password and only few segments are enable to edit
            Documents.Add Template:=DocName & "Copy", NewTemplate:=False, DocumentType:=0

            'Since Document.Add its suppose to promp as the Active document
            'Paste the contents and save
            'With Documents(DocName & "Copy")
            With ActiveDocument
                .PasteAndFormat (wdUseDestinationStylesRecovery)
                .SaveAs DocPath
            End With
            'Documents(DocName & "Copy").Close SaveChanges:=True

        Next
    'If the user presses Cancel...
    Else
    End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Sub

但是，正如您所猜测的，它不能像您所期望的那样工作，也不能创建副本，也不能创建具有名称的新文档。因此，任何方向正确的范围都将受到欢迎。 提前感谢所有的答案

为了将来的参考，这里是基于@Charlie的响应而改进的代码

---

我会尝试创建一个新的Word文档，然后使用此行插入受保护Word文档中的文本。这与进入“插入功能区”选项卡->对象->文件中的文本相同

Selection.InsertFile FileName:="protected.docx", Range:="", _
    ConfirmConversions:=False, Link:=False, Attachment:=False

Selection.InsertFile FileName:="protected.docx", Range:="", _
    ConfirmConversions:=False, Link:=False, Attachment:=False