我使用下面的宏将合并的邮件拆分为单独的文档。我需要的是分成单独的文件,保持整个页面包括页眉和页脚,并保存在页面上的第一个合并字段,这是合并字母的第一条信息。
但是,宏只运行一个字母而不是其余字母,格式完全不正确。它更改字体,页面布局,不包括页眉和页脚。它还可以保存为' 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:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & "Ref"
Target.Close
Next i
End Sub
答案 0 :(得分:1)
为这个老问题提供了替代答案,因为我最近不得不自己解决该问题,而在搜索该问题时,该问题的排名仍然很高。
我从https://word.tips.net/T001538_Merging_to_Individual_Files.html处的宏开始,对其进行了修改,以首先基于邮件合并文件创建单独的空白文档,以保留页眉,页脚和格式。这可能是一种低效的方法,但不需要弄乱模板。
以下宏应从需要合并的邮件合并输出文档中运行。
Sub BreakOnSection()
'***Update the working folder location below***
ChangeFileOpenDirectory "C:\C:\Users\User\Downloads"
'***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”,我需要保持打开状态以保持宏在运行。完成后可以安全地删除此文件。可能可以避免这种情况,但是我想避免需要从模板运行宏,而没有想出更好的方法。
答案 1 :(得分:0)
这只是第二部分的答案:
这一行:
If InStr(oField.Code.Text, "Ref") > 0 Then
找到合并字段"参考"在里面。如果您需要一个不同的合并域,您应该将要保存文件的合并域的名称放在" Ref"是的,所以如果你的合并域是,"收件人"然后将其更改为:
If InStr(oField.Code.Text, "Address") > 0 Then
此外,您的最后一行是使用STRING" Ref"保存文件名。而不是变量。您需要删除Ref周围的引号。它应该是:
Target.SaveAs FileName:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref
就其他方面而言,您可以使用另一种方法(我现在没有时间为此提供代码)。找到每个范围的第一页和最后一页(设置为变量Letter)并将这些页打印到word doc。这将保持页眉和页脚。您需要输入的代码是:
Letter.Information(wdActiveEndPageNumber)
获取范围结束的页码(不确定,但我假设(wdActiveStartPageNumber)或类似的东西将获得范围的第一页
和
Application.PrintOut From:=FirstPageNum, To:=LastPageNum, OutputFileName:=:="\\svr4958file01\Libraries\u20480\Documents\On Hold letters Template\20150512 On hold Letters Customers Active and Cancelled\" & Ref & ".doc"
如果我有空的话,稍后会更新。