通过 FileDialog box picker 复制一个文档的内容，到一个新的

Question

在 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

的响应

Sub Backup()
Dim DocName As String
Dim NewDoc As Document

'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

            'Create Backup File with ability to modify it, since the original is protected by password and only few segments are enable to edit
            Set NewDoc = Documents.Add

            'Since Document.Add its suppose to promp as the Active document
            'Paste the contents and save
            With NewDoc
                Selection.InsertFile FileName:=vrtSelectedItem, Range:=vbNullString, _
                ConfirmConversions:=False, Link:=False, Attachment:=False
                .SaveAs FileName:=vrtSelectedItem & "_BACKUP.docx"
                .Close
            End With

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

End Sub

Answer 1

我会尝试创建一个新的 Word 文档，然后使用这一行 "insert the text from the protected Word doc." 这与转到“插入功能区”选项卡 -> 对象 -> 来自文件的文本相同。

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