邮件合并与循环/分组
邮件合并与循环/分组
提问于 2022-05-30 09:25:00
我有一个Excel表，用于将邮件合并到word中。
邮件合并是通过以下代码完成的
'starting the mail merge for the main body of the report
Set wdDoc = wdApp.Documents.Open(fNameW)
wdDoc.Activate
wdDoc.MailMerge.OpenDataSource Name:=(fNameE), Revert:=False, Connection:="Entire Spreadsheet", SQLStatement:="SELECT * FROM `'Table of Recommendations$'`", SQLStatement1:=""
With wdDoc.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute
For Each wd In ActiveDocument.StoryRanges
With wd.Find
.Text = "(blank)"
.Replacement.Text = ""
.Forward = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
With wd.Find
.Text = "^b"
.Wrap = wdFindContinue
While .Execute
wd.Delete
wd.InsertParagraph
Wend
End With
Next wd这是我得到的输出：
现在，我的问题。我要实现的是，建议号(b)仅在建议号(a)下插入第一个表格，因为这两项建议来自同一问题国家合作。换句话说，合并过程应该遍历Excel表，如果问题相同，则应该将建议分组，省略空白单元格，而不是生成第二个表。你觉得这有可能吗？如果是，你能给我指明正确的方向吗？我已经搜索了所有的互联网，但一直未能找到任何解决办法。谢谢。
Stack Overflow用户
回答已采纳
发布于 2022-06-05 19:41:42
我按照@macropod的建议解决了我的问题。使用https://www.msofficeforums.com/mail-merge/38721-microsoft-word-catalogue-directory-mailmerge-tutorial.html提供的指导方针，我能够解决这个问题。我设置了邮件合并模板，如afire指南第4页所述，添加了前面指南第20/21页中描述的表合并宏，并解决了我的问题。下面是我编写的代码示例：
'starting the mail merge for the main body of the report
With wdApp 'launching Ms Word
fNameW = "C:\Users\" & uName & "\OneDrive...\Main Body.dotx"
.Visible = True
.Documents.Open fNameW, , ReadOnly
Set wdDoc = wdApp.Documents.Open(fNameW)
wdDoc.Activate
wdDoc.MailMerge.OpenDataSource Name:=(fNameE), Revert:=False, Connection:="Entire Spreadsheet", SQLStatement:="SELECT * FROM `'Table of Recommendations$'`", SQLStatement1:=""
With wdDoc.MailMerge
.MainDocumentType = wdCatalog
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute
For Each wd In ActiveDocument.StoryRanges
With wd.Find
.Text = "(blank)"
.Replacement.Text = ""
.Forward = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next wd
For Each oPara In ActiveDocument.Paragraphs
With oPara.Range
If .Information(wdWithInTable) = True Then
With .Next
If .Information(wdWithInTable) = False Then
If .Text = vbCr Then .Delete
End If
End With
End If
End With
Next
ChangeFileOpenDirectory fod
ActiveDocument.SaveAs2 Filename:=fnameMB, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
ActiveDocument.Close
End With
Sheets("Table of Recommendations").Select
Range(rangeTC).Select
Selection.Clear
wdDoc.Close savechanges:=wdDoNotSaveChanges页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72432014
复制相关文章
相似问题
腾讯云开发者
