具有循环 /分组的邮件合并(excel mail merge)

我有一个 Excel 表,我用它来做一个邮件合并成单词。

我有一个 Excel 表,我用它来做一个邮件合并成单词。

Excel Table

邮件合并是通过这段代码完成的

'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

这是我得到的输出:

enter image description here

现在,我的问题。我想实现的是,建议号 (b) 入到第一个表中,就在建议号 (a) 下,基于两个建议来自同一问题国家合作的事实。换句话说,合并过程应该循环通过 Excel 表,如果问题是相同的,它应该将建议组合在一起,省略任何空白单元格,而不是生成第二个表。如果这是

1

我建议你改变你的数据包括例如“RecommendationText”你现在在两个单元格中的值变成一个多行单元格:

(a) Expedite an evaluation ... [AltGr][Enter]
(b) Develop, publish and disseminate
1

将连接列添加到数据库数据的副本中
= IF ($C13 = "",E12 & amp;CHAR (10) & amp;D13,E12)...

过滤非空行的数据(例如 col“背景”)

.
.
Screenshot with "concatenating column"
enter image description here

.
.
Screenshot filtered data enter image description here

0

我已经按照 @ 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

本站系公益性非盈利分享网址,本文来自用户投稿,不代表码文网立场,如若转载,请注明出处

(508)
抛硬币顺序中头或尾的平均条纹数(heada or tails)
上一篇
更改 gmail主题行
下一篇

相关推荐

发表评论

登录 后才能评论

评论列表(64条)