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

Question

我一直在尝试找出一种方法，在执行邮件合并后，将文档分离为单独的文档，并以特定的项目命名，最好是标题的第一行。我只能找到拆分文档的方法，但不知道如何命名。任何关于如何编写VBA代码以将文档另存为标题的帮助都将非常感谢。

Answer 1

由于您已经将文档分开，下面的代码可能会使用它们的第一句话给出它们的名称。

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

在保存文件之前，您可能需要检查是否存在重复项。为此，使用Dir()函数，并使用上面包含的系统为第一句可能为空的文件命名，并添加一个数字来重复名称。

您可能还需要检查文件名中不允许使用的字符。我简单地排除了所有低于ASCII(32)和高于ASCII(128)的，然后是Windows不喜欢的已知代码。您可能希望进一步修改该范围。

要调用上述函数，请使用如下代码：-

Private Sub GetName()
    Debug.Print DocName(ActiveDocument)
End Sub

Answer 2

这是我到目前为止拥有的代码，我可以从一个非常有用的网站上找到它，但代码另存为单词"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