Mail Merge Document Separation 1

[JayDM]

Hi, im trying to separate mail merge documents into separate files so i can save each letter in a mail merge as a separate file.

Save each merged letter as a separate file
Normally, the mail merge result to a new document is one long file which can be edited and printed. Using the Master Document feature, it's possible to save each as a separate file. In the mail merge result document, each record's letter is created in its own section, so one can select each section, turn it into a sub-document, open the sub-document and save it as a separate file.

The only preparation you need to make in the main merge document is to select the first paragraph, go to Format/Paragraph and set the Outline Level to 1 (one). The Master Document feature needs this in order to create the sub-document.

The following sample VBA code can help automate this process.

Sub SaveRecsAsFiles
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub

Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
  doc.Sections(secCounter).Range
Next secCounter
End Sub

Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub

Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub

that is what i've been given as a guide - yet it makes no real sense and although i've followed it as much as i can, it isnt giving me anything useful.

any help at all would be really appreciated as i need to be able to do this asap.

thanks

Jay

 

[SkipVought]

I'm at a loss on this one.

What happens if you put a Watch on this statement and step into the procedure? I can see the RecordCount, and ActiveRecord values.

ActiveDocument.MailMerge.DataSource

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

Value:
<Expression not defined in context>
Type:
Empty


Recordcount=-1

 

[SkipVought]

OK. Just for grins, check the objects up the line in Watch...

ActiveDocument.MailMerge    'probably not defined
ActiveDocument              'porbably is defined

I'm guessing that the MailMerge object is the culprit. Have you actually set up the MailMerge document parameters?

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

Skip,

If i merge the document by hand all ends just fine.
I added a watch on ActiveDocument and get a lot of stuff which seems fine too!

DataSource is the same!

 

[SkipVought]

I expected ActiveDocument to be OK.

What did ActiveDocument.MailMerge indicate?

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[SkipVought]

Jerry,

Try adding this statement

   With ActiveDocument.MailMerge.DataSource[b]
      .EditDataSource[/b]

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

ActiveDocument.MailMerge
Type: ObjectMailMerge

DataSource --> MailMergeDataSource/MailMergeDataSource
Destination --> wdSendToNewDocument
MainDocumentType-->wdFormLetters
State-->wdMainAndDataSource

For DataSource now I get
ConnectString --> QUERY qdfCurCustomer
Name --> the full path and name of the mdb file
QueryString --> SELECT * FROM [qdfCurCustomer]
RecordCount --> -1
TableName --> SELECT * FROM [qdfCurCustomer]
Type --> wdMergeInfoFromAccessDDE
Destination-->wdSentToNewDocument

Drives you crazy, doesn 't it?

 

[JerryKlmns]

.EditDataSource

opens the query perfectly!

 

[SkipVought]

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

Skip

I think I gave you the wrong impression that everything worked, didn't I?

Well my friend the answer is still no. I even tried an excel WB as database with no joy. I 'm doing this 'cause I have to fax those docs to each customers' fax number using the Captaris RightFax 9.3 Only for ~1000 customers that is.

 

[SkipVought]

I have no other suggestions.

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

Ok then

I 'll have to merge on record at a time.
Here 's what I 'll do
Create a query with only one record, open and merge it.Save the merged document.Close it. Looping all the records.

If you could take a look

Sub CreateCusDocuments()
Dim qdf As DAO.QueryDef
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim rst As ADODB.Recordset
Const strFileName = "merge.doc"
    
    Set objWord = New Word.Application
    objWord.Visible = True
    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = CurrentProject.Connection
        .CursorLocation = adUseServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockOptimistic
        .Source = "SELECT CusFaxing.* FROM CusFaxing ORDER BY ID;"
        .Open
        Do While Not .EOF
            Set qdf = CurrentDb.QueryDefs("qdfCurCustomer")
            qdf.SQL = "SELECT CusFaxing.* FROM CusFaxing WHERE ID=" & .Fields("ID")
            qdf.Close
            Set qdf = Nothing
            Set objDoc = objWord.Documents.Open(CurrentProject.Path & "\" & strFileName)
            If Dir(CurrentProject.Path & "\" & .Fields("ID") & ".doc") <> "" Then Kill CurrentProject.Path & "\" & .Fields("ID") & ".doc"
            objDoc.MailMerge.OpenDataSource Name:=CurrentProject.FullName, LinkToSource:=True, AddToRecentFiles:=False, Connection:="QUERY qdfCurCustomer", SQLStatement:="SELECT * FROM [qdfCurCustomer]"
            objDoc.MailMerge.Destination = 0 'wdSendToNewDocument
            objDoc.MailMerge.Execute
            objWord.Application.Documents(1).SaveAs (CurrentProject.Path & "\" & .Fields("ID") & ".doc")
            objWord.Application.Documents(2).Close 0 'wdDoNotSaveChanges
            .Fields("IsLetterCreated") = True
            .Update
            .MoveNext
        Loop
        .Close
    End With
    Set rst = Nothing
    Set objDoc = Nothing
    objWord.Quit
    Set objWord = Nothing
    

End Sub

Thank for your time

 

[SkipVought]

Try using MS Query instead of ADO.

You connect the source with Word using the NATIVE MailMerge dialog, not ADO via VBA.

Skip,

_{When a group touring the Crest Toothpaste factory got caught in a large cooler, headlines read...
Tooth Company Freeze a Crowd! and
Many are Cold, but Few are Frozen!}

 

[JerryKlmns]

Skip

I did it like that from the first time. No ADO VBA datasource.
I try onother way

 Dim fname As String
 Dim iCount As Long, lStop As Long
    lStop = 2
    For iCount = 1 To lStop
        ActiveDocument.MailMerge.Destination = wdSendToNewDocument
        ActiveDocument.MailMerge.SuppressBlankLines = True
        ActiveDocument.MailMerge.DataSource.FirstRecord = iCount 'wdDefaultFirstRecord
        ActiveDocument.MailMerge.DataSource.LastRecord = iCount 'wdDefaultLastRecord
        ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
        fname = "C:\Documents and Settings\jerryklmns\Desktop\Faxing1000\" & ActiveDocument.MailMerge.DataSource.DataFields("ID").Value & ".doc"
        ActiveDocument.MailMerge.Execute Pause:=False
        ActiveDocument.SaveAs FileName:=fname
        ActiveDocument.Close
    Next
End Sub

It works. Not what I want but.. my sons need me and I have a 2h trip to get chez moi!

Skip. Thanks. I appreciate your effort.

 

[JerryKlmns]

Skip.
I gave up doing it from mdb. The following code runs as expexted form the merging document

Dim fname As String
        With Documents("MergeDB.doc").MailMerge
            .DataSource.ActiveRecord = wdFirstDataSourceRecord
            Do
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                With .DataSource
                    .FirstRecord = .ActiveRecord
                    .LastRecord = .ActiveRecord
                    fname = "C:\Documents and Settings\gkaloumenos\Desktop\Faxing1000\" & .DataFields("ID").Value & ".doc"
                    .ActiveRecord = wdNextRecord
                End With
                .Execute Pause:=False
                ActiveDocument.SaveAs FileName:=fname
                ActiveDocument.Close
            Loop Until .DataSource.ActiveRecord = .DataSource.RecordCount
        End With
[code]