Solved: Mail Merge to seperate documents the save documents as merge field values

[Doughboy]

I found the below code to split a mail merge into one document per record in the datasource, now i need to add code to save each document as a merge field value, or combination of merge field values, can anyone help ?


Sub AllSectionsToSubDoc()

Dim x As Long
Dim Sections As Long
Dim Doc As Document

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc")
ActiveDocument.Close False
Next x

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

[MOS MASTER]

Hi & welcome to VBAX Doughboy, :hi:


I found the below code to split a mail merge into one document per record in the datasource, now i need to add code to save each document as a merge field value, or combination of merge field values, can anyone help ?


Actually your code works on the already merged document and does not produce a document per record in the datasource. (But I understand it looks that way)

In fact it loops the Sections (generated by mailmerge) of the document and saves the content of that section into a new document.

Ofcourse this works great now for the needs that you had but your second question conflicts whit your current code.

Your question is to save (I presume you mean the document name) each document based upon Merge field value(s)

This is possible ofcourse but not the way your code works now. Your working document is the result of the mailmerge and for what you want to work wel your code needs to do the mailmerge as well. (At that time the mailmerge field data is queryable and you can use them)

I want to help you with this problem but I need some test data to work with. So could you provide me with:
* Test excel document (as merge db)
* Test word document (attached to the excel workbook)
* Explain which fields you want to use in what way.

If there's time tomorrow I'll look at it.

HTH

[Doughboy]

Hi M.O.S Master, thanks for taking an interest in my case,

Attached is a test excel file (sheet 1 is the datasource) and test word mail merge template, i guess what i need is the flexability to run the mail merge, save each doc record individualy and specify doc names to be a combination of merge fields in the data source, i.e "Counterparty Long Name" & "NB.INT" & "NB.LTI" & "TRN.DATE", and also specifly a file path where the docs are to be saved,

thanks heaps for your help, most apreciated, Regards, Doughboy


NB.INT
NB.INT

[MOS MASTER]

Hi Doughboy, :yes

That's quite a list but no problem.
I'll try to look at it asap

[Tinbendr]

Graham Mayor has written (http://www.gmayor.com/individual_merge_letters.htm) extensively on this.

See the very last section.

Here is my take on the filename.
Sub AllSectionsToSubDoc()
Dim x As Long
Dim Sections As Long
Dim Doc As Document
Dim FName$
Dim dDate$
Dim TRN_LRN As Range
Dim TRN$
Dim LRN$
Dim DocFileName$
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
FName$ = Doc.Sections(2).Range.Tables(2).Rows(1).Range.Text
'Remove end of cell trash
FName$ = Left(FName$, Len(FName$) - 4)
dDate$ = Doc.Sections(x).Range.Tables(3).Range.Text
dDate$ = Mid(dDate$, 7, Len(dDate$) - 10)
'You don't say that the length of the TRN and LRN
'could change in length, so I'll assume they will.
'Based on that, the extraction is a little more
'complicated. I've use Range instead of inSTR()
Set TRN_LRN = Doc.Sections(x).Range.Tables(4).Range
TRN_LRN.MoveStartUntil ":"
TRN_LRN.MoveStart wdCharacter, 2
TRN_LRN.MoveEndUntil "(L", wdBackward
TRN_LRN.MoveEnd wdCharacter, -3
TRN$ = TRN_LRN.Text

'Redefine the object again.
Set TRN_LRN = Doc.Sections(x).Range.Tables(4).Range
'We'll look for the second colon this time.
TRN_LRN.MoveStartUntil ":"
'Move past the first colon
TRN_LRN.MoveStart wdCharacter, 2
TRN_LRN.MoveStartUntil ":"
TRN_LRN.MoveStart wdCharacter, 2
TRN_LRN.MoveEndUntil ")", wdBackward
TRN_LRN.MoveEnd wdCharacter, -1
LRN$ = TRN_LRN.Text

DocFileName$ = FName$ & " " & TRN$ & " " & LRN$ & " " & dDate$ & ".doc"
Doc.Sections(x).Range.Copy
Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs (Doc.Path & "\" & DocFileName$)
ActiveDocument.Close False
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[MOS MASTER]

Hi Tin, :yes

Nice demonstration on how to parse a merged document.

[MOS MASTER]

Hi Doughboy, :yes

I've incorporated my code into the attachment. To try open the word document (re-attach to datasource if needed). Press ALT+F8 and run the macro MergeDocument

My code takes care of the full mailmerge and uses the data from the merge to parse the path of the newly created document.

As per request it also asks the user in which folder the merge files need to be stored.

The code:

Option Explicit
Dim sMergePath As String

Sub MergeDocument()
Dim iCnt As Integer
Dim oDoc As Word.Document
sMergePath = MergeFolder
If sMergePath = vbNullString Then Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set oDoc = ActiveDocument
For iCnt = 1 To oDoc.MailMerge.DataSource.RecordCount
DoMerge oDoc, iCnt
Next
Application.DisplayAlerts = True
Set oDoc = Nothing
End Sub

Sub DoMerge(oDocument As Document, iRecord As Integer)
Dim sCPLongName As String
Dim sNBInt As String
Dim sNBLti As String
Dim sTrnDate As String
Dim sCombPath As String
With oDocument.MailMerge
With .DataSource
.FirstRecord = iRecord
.LastRecord = iRecord
.ActiveRecord = iRecord
sCPLongName = .DataFields("Counterparty_Long_Name").Value
sNBInt = .DataFields("NBINT").Value
sNBLti = .DataFields("NBLTI").Value
sTrnDate = Format(.DataFields("TRNDATE").Value, "dd-mm-yyyy")
End With
.Destination = wdSendToNewDocument
.Execute
End With

sCombPath = sMergePath & Application.PathSeparator & _
sCPLongName & "_" & sNBInt & "_" & sNBLti & _
"_" & sTrnDate & ".doc"

SaveDocument sCombPath
End Sub

Sub SaveDocument(sPath As String)
With ActiveDocument
.SaveAs sPath
.Close
End With
End Sub

Function MergeFolder() As String
MergeFolder = vbNullString
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder where you want the files to be merged"
If .Show = -1 Then
MergeFolder = .SelectedItems(1)
End If
End With
End Function


WARNING, this sort of code will never run fast and once executed please leave the computer (Word) alone to finish the process.

Good luck and have fun! :whistle:

[Doughboy]

Absolutly Briliant, or as in kiwiland we say, sweet as piece of code,

thanks a million, Doughboy Out

[MOS MASTER]

Sweet! Glad we could help. :yes