将文件名保存为递增数字的 Word 文件

Question

我在 Internet 上找到了一个宏，它可以将 Word 文档中的选择保存为一个新文档。

Sub SaveSelectedTextToNewDocument()
    If Selection.Words.Count > 0 Then
        'Copy the selected text
        Selection.Copy

        'Open a new document and paste the copied text into it
        Dim objNewDoc As Document
        Set objNewDoc = Documents.Add
        Selection.Paste

        'Get the first 10 characters as the filename of the new document and save them
        Dim objFileName As Range
        Set objFileName = objNewDoc.Range(Start:=0, End:=10)
        objNewDoc.SaveAs FileName:="C:\Users\Test\Desktop\" & objFileName & ".docx"
    Else

    End If
End Sub

我不想保存文件名是文档前10个字母的文件。我希望文件名的数量增加（例如 1.docx、2.docx、3.docx 等等）。

Answer 1

这是一个应该起作用的宏：

Sub SaveSelectedTextToNewDocumentNumbered()
' Charles Kenyon  16 October 2021
' 
'
Retry:
    If Selection.Words.Count > 0 Then
        'Copy the selected text
        Selection.Copy

        'Open a new document and paste the copied text into it
        Dim objNewDoc As Document
        Dim currentDoc As Document
        Dim sFileName As String
        Dim i As Integer
        Set currentDoc = ActiveDocument
        On Error GoTo CreateVar
        i = currentDoc.Variables("SaveNum")
        On Error GoTo -1
        i = i + 1
        Let sFileName = currentDoc.Name
        Set objNewDoc = Documents.Add
        Selection.Paste
        ' save  and assign name
        objNewDoc.SaveAs FileName:=sFileName & i
        ' update variable
        currentDoc.Variables("SaveNum") = i
        ' save original document with new variable
        currentDoc.Save
        ' cleanup
        Set currentDoc = Nothing
        Set objNewDoc = Nothing
        On Error GoTo -1
    End If
    Exit Sub
CreateVar:
    ActiveDocument.Variables("SaveNum") = 0
    GoTo Retry
End Sub

将文件名保存为递增数字的 Word 文件

Save Word Files with Filenames as Increasing Numbers

vba

ms-word