Reputation: 71
I have an Excel table, which I use to do a mail merge into word.
The mail merge is done through this code
'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
And this is the output I get:
Now, my question. What I would like to achieve is that recommendation number (b) gets inserted in the first table, just under recommendation number (a), based on the fact that the two recommendations arise from the same issue Country Cooperation. In other words, the merge process should loop through the Excel table and if the issue is the same, it should group the recommendations together, omit the blank cells, and not generate the second table. Do you think this is possible? If yes, can you point me in the right direction? I have searched allover the internet but have not been able to find any solution. Thank you.
Upvotes: 0
Views: 1515
Reputation: 71
I have solved my problem following the suggestions given by @macropod. Using the guideline available at https://www.msofficeforums.com/mail-merge/38721-microsoft-word-catalogue-directory-mailmerge-tutorial.html, I was able to sort the issue out. I set-up the mail merge template as described in page 4 of the afire guideline, added the table joiner macro described in pages 20/21 of the afore guidelines and solved my issue. Below a sample of the code I wrote:
'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
Upvotes: 0
Reputation: 1139
add a concatenating column to a copy of your database data
=IF($C13="",E12&CHAR(10)&D13,E12) ... for the row 12 in the example below
filter your data for non empty lines (e.g. col "Background")
.
.
Screenshot with "concatenating column"
Upvotes: 1
Reputation: 1139
I do propose that you change your data! Include e.g. "RecommendationText" values which you have in two cells now into one multiline cell:
(a) Expedite an evaluation ... [AltGr][Enter]
(b) Develop, publish and disseminate
Upvotes: 1