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

这是我到目前为止的代码，我能够从一个非常有用的网站找到它，但代码保存为＆＃34;报告＆＃34;我现在设置它，而我试图找出它，然后是文档的编号。

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

MS Word VBA：使用标题

2 个答案: