MS Word Mail合并并拆分文档保存,标题和页脚问题



我正在使用以下宏将合并的邮件拆分为单独的文档。我需要的是,将整个页面分开为单独的文档,包括标头和页脚,并像页面上的第一个合并字段一样保存,这是合并字母上的第一条信息。

但是,宏仅在一个字母的不是其余的字母上运行,格式是完全不正确的。它更改字体,页面布局,不包括标头和页脚。它还保存为" ref",而不是字母上的第一个合并字段。

有人知道如何修改下面的代码,以便使用上述字母正确更新吗?我知道这看起来真的很糟糕,但我是VBA的新手,我的项目中没有人寻求帮助。预先感谢

Sub splitter()
' Based on a macro by Doug Robbins to save each letter created by a mailmerge as a separate file.
' With help from http://www.productivitytalk.com/forums/topic/3927-visual-basic-question-for-merge-fields/
Dim i As Integer
Dim Source As Document
Dim Target As Document
Dim Letter As Range
Dim oField As Field
Dim Ref As String
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
    Set Letter = Source.Sections(i).Range
    Letter.End = Letter.End - 1
        For Each oField In Letter.Fields
        If oField.Type = wdFieldMergeField Then
            If InStr(oField.Code.Text, "Ref") > 0 Then
            'get the result and store it the Ref variable
            Ref = oField.Result
            End If
        End If
        Next oField
    Set Target = Documents.Add
    Target.Range = Letter
    Target.SaveAs FileName:="\svr4958file01Librariesu20480DocumentsOn Hold letters Template20150512 On hold Letters Customers Active and Cancelled" & "Ref"  
Target.Close
Next i
End Sub

为这个旧问题提供替代答案,因为我最近必须自己解决它,而在搜索此问题时,这个问题仍然很高。

我从宏开始,网址为https://word.tips.net/t001538_merging_to_individual_files.html,将其修改为首先基于邮件合并文件创建单独的空白文档,以保留标头,页脚,页脚和格式。这可能是一种效率低下的方法,但不需要与模板混乱。

应从邮件合并输出文档中运行以下宏。

Sub BreakOnSection()
     '***Update the working folder location below***
     ChangeFileOpenDirectory "C:C:UsersUserDownloads"
     '***Update the original mail merge file name below***
     mailmergeoriginal = "Original Mail merge.docx"
    'Makes code faster and reduces screen flicker
    Application.ScreenUpdating = False
    'Used to set criteria for moving through the document by section.
    Application.Browser.Target = wdBrowseSection
    SectionCount = ActiveDocument.Sections.Count
    'Save a template for each mailmerge document
    ActiveDocument.StoryRanges(wdMainTextStory).Delete
    DocNum = 1
    For i = 1 To (SectionCount - 1)
        ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
        DocNum = DocNum + 1
    Next i
    ActiveDocument.SaveAs FileName:="Macro temp.docx"
    Documents.Open FileName:= mailmergeoriginal
    Documents("Combined Offers.docx").Activate
    'A mailmerge document ends with a section break next page
    DocNum = 1
    For i = 1 To (SectionCount - 1)
        'Select and copy the section text to the clipboard
        ActiveDocument.Bookmarks("Section").Range.Copy
        'Create a new document to paste text from clipboard
        Documents.Open FileName:="Mail merge " & DocNum & ".docx"
        'To save your document with the original formatting'
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
        'Removes any break copied at the end of the section
        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
        ActiveDocument.SaveAs FileName:="Mail merge " & DocNum & ".docx"
        ActiveDocument.Close
        DocNum = DocNum + 1
        'Move the selection to the next section in the document
        Application.Browser.Next
    Next i
End Sub

请注意,该宏将在运行后留下一个额外的文件,称为" Macro Temp.docx",我需要保持打开状态以保持宏运行。完成后可以安全删除此文件。这可能是可以避免的,但是我想避免需要从模板运行宏,并且没有提出更好的方法。

这只是对第二部分的答案:

这一行:

If InStr(oField.Code.Text, "Ref") > 0 Then

在其中找到了带有" ref"的合并。如果您需要不同的合并菲尔德,则应将要保存为" ref"的Mergefield的名称,因此,如果您的Mergefield为" Reveseee",则将其更改为:

If InStr(oField.Code.Text, "Address") > 0 Then

另外,您的最后一行是用字符串" ref"而不是变量保存文件名。您需要删除参考文献。它应该阅读:

Target.SaveAs FileName:="\svr4958file01Librariesu20480DocumentsOn Hold letters Template20150512 On hold Letters Customers Active and Cancelled" & Ref

在其余方面,您可以使用替代方法(我真的没有时间为此提供代码)。找到每个范围的第一页和最后一页(设置为可变字母),然后将这些页面打印到Word Doc。这将保持标题和页脚。您需要输入的代码将是:

Letter.Information(wdActiveEndPageNumber) 

要获取范围末端的页码(不确定,但是我假设(wdactivestartpagenumber)或类似的东西将获得该范围的第一页

Application.PrintOut From:=FirstPageNum, To:=LastPageNum, OutputFileName:=:="\svr4958file01Librariesu20480DocumentsOn Hold letters Template20150512 On hold Letters Customers Active and Cancelled" & Ref & ".doc"

如果我有时间,稍后会更新。

最新更新