MS Word VBA：使用标题保存文档

我一直在试图找到一种方法，在执行邮件合并后，将文档分离为单独的文档，并以特定项目命名，最好是标题的第一行。我只能找到拆分文档的方法，但无法确定如何命名它。如果您有任何关于如何编写VBA代码以将文档保存为标题的帮助，我们将不胜感激

由于您已经分隔了文档，下面的代码可能会使用它们的第一句话为它们命名

Private Function DocName(Doc As Document) As String
    ' 23 Aug 2017

    Const Illegals As String = "\:/;?*|>"""
    Static FaultCounter As Integer
    Dim Fun As String
    Dim Title As String
    Dim Ch As String
    Dim i As Integer

    Title = Trim(Doc.Sentences(1))
    For i = 1 To Len(Title)
        Ch = Mid(Title, i, 1)
        If (Asc(Ch) > 31) And (Asc(Ch) < 129) Then
            If InStr(Illegals, Ch) = 0 Then Fun = Fun & Ch
        End If
    Next i

    If Len(Fun) = 0 Then
        FaultCounter = FaultCounter + 1
        Fun = Format(FaultCounter, """Default File Name (""0"")""")
    End If

    DocName = Fun
End Function

---

这是到目前为止我所拥有的代码，我能够从一个非常有用的网站上找到它，但是代码保存为“report”一词，我现在正在尝试找出它，然后是文档的编号

Option Explicit

Sub splitter()

' splitter Macro

' Macro created by Doug Robbins to save each letter created by a mailmergeas 
a separate file.
Application.ScreenUpdating = False
Dim Program As String
Dim DocName As String
Dim Letters As Integer, Counter As Integer

Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
'program = ActiveDocument.MailMerge.DataSource.DataFields("Program_Outcomes_PlanReport_Name").Value
DocName = "Reports" & LTrim$(Str$(Counter))  'Generic name of document
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous


ActiveDocument.SaveAs filename:="E:\assessment rubrics\Templates" & "\" & DocName, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", 
AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False,         SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend

Application.ScreenUpdating = True

End Sub

选项显式
子拆分器（）
'拆分器宏
'由Doug Robbins创建的宏，用于将mailmergeas创建的每个字母保存为
一个单独的文件。
Application.ScreenUpdating=False
将程序设置为字符串
将DocName设置为字符串
将字母设置为整数，计数器设置为整数
Letters=ActiveDocument.Sections.Count
Selection.HomeKey单位：=wdStory
计数器=1
而反字母
'program=ActiveDocument.MailMerge.DataSource.DataFields（“程序结果计划报告名称”）.Value
DocName=“Reports”<rim$（Str$（Counter））'文档的通用名称
ActiveDocument.Sections.First.Range.Cut
文件。添加
选择。粘贴
ActiveDocument.Sections（2）.PageSetup.SectionStart=wdSectionContinuous
ActiveDocument.SaveAs文件名：=“E:\assessment rubrics\Templates”&“\”&DocName，文件格式：=wdFormatDocument，LockComments:=False，密码：=”，
AddToRecentFiles:=False，WritePassword:=False，ReadOnlyRecommended:=False，EmbeddeTrueTypeFonts:=False，SaveNativePictureFormat:=False，SaveFormsData:=False，SaveAsoceLetter:=False
活动窗口，关闭
计数器=计数器+1
温德
Application.ScreenUpdating=True
端接头

你能发布你当前的代码吗？我在这篇文章中添加了一个单独的帖子，我想出了如何将我的文件命名为我想要的名称，现在麻烦的是保存它。这是问题的标题：MS Word VBA:保存文件，运行时错误5152

Option Explicit

Sub splitter()

' splitter Macro

' Macro created by Doug Robbins to save each letter created by a mailmergeas 
a separate file.
Application.ScreenUpdating = False
Dim Program As String
Dim DocName As String
Dim Letters As Integer, Counter As Integer

Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
'program = ActiveDocument.MailMerge.DataSource.DataFields("Program_Outcomes_PlanReport_Name").Value
DocName = "Reports" & LTrim$(Str$(Counter))  'Generic name of document
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous


ActiveDocument.SaveAs filename:="E:\assessment rubrics\Templates" & "\" & DocName, FileFormat:=wdFormatDocument, LockComments:=False, Password:="", 
AddToRecentFiles:=False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False,         SaveAsAOCELetter:=False
ActiveWindow.Close
Counter = Counter + 1
Wend

Application.ScreenUpdating = True

End Sub