创建Word文档的副本，然后继续编辑文档

Question

每当我按下快捷键时，我都会尝试复制文档，然后继续使用原始文档。副本应该与我的文档在同一目录中，但名称由日期/时间字符串修改。

该代码在适当的目录中创建适当的命名文件，但当打开时，保存的文档不包含任何内容，并显示"；单词"作为标题。

Sub Checkpoint()
Dim SplitFullName() As String
Dim ThisFullName As String
Dim CopyFileName As String
Dim CopyDoc As Document
Dim DateTimeString As String
ThisFullName = ActiveDocument.FullName

SplitFullName = Split(ThisFullName, ".", 2) ' Split filename at the dot
DateTimeString = Format(Now(), "yymmddhhmmss")
CopyFileName = SplitFullName(0) & " " & DateTimeString & "." & SplitFullName(1)

Selection.WholeStory ' I want to select and copy the entire current document
Selection.Copy
' Create new open document with curent document as template
Set CopyDoc = Documents.Add(ActiveDocument.FullName) ' Copy document now active
Selection.Paste
' at this point the copy document is visible on screen
' with the right content and name in heading

CopyDoc.SaveAs2 (CopyFileName)      '   Save the copy with date/time in filename
CopyDoc.Close          ' and close and remove the copy document
End Sub

Answer 1

您可以使用Filesystem对象来复制打开的文件。

Public Sub Checkpoint()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim CopyFileName As String
With ActiveDocument
.Save
CopyFileName = getFileNameWithoutExtension(.Name) & " " & Format(Now(), "yymmddhhmmss") & "." & getFileExtensionFromFilename(.Name)
fso.CopyFile .FullName, .Path & "" & CopyFileName
End With

End Sub
Private Function getFileNameWithoutExtension(ByVal Filename As String) As String
getFileNameWithoutExtension = Left(Filename, InStrRev(Filename, ".") - 1)
End Function

Private Function getFileExtensionFromFilename(ByVal Filename As String) As String
getFileExtensionFromFilename = Right(Filename, Len(Filename) - InStrRev(Filename, "."))
End Function

关于检索新文件名的方法：如果在文件名中使用点，它将不起作用。使用InStrRev更安全，它从右到左查找第一个点，这将是分隔扩展名和基本名称的点。

Answer 2

您真的需要将新创建的文件保存为启用宏的文件((.docm((吗？您可以对新创建的文件使用"docx"扩展名。

CopyFileName = SplitFullName(0) & " " & DateTimeString & "." & "docx"