Mail Merge / DDE

[score]

Sorry folks for posting the thread twice but I'm need to desprate help...

I'm able to successfully to perform mail merge but only one record at a time. In our org. we send thank-you letters out to our clients whose info. are stored in SQL DB.

Once a template is been created and all the bookmarks are inserted. I would like to perfom a mail merge using the template and info from the database, produce the thank-you letters.

Currently what I'm doing is,

Start Word application
Open Word template
Insert Text at specified bookmark
Print the document
Close word application
And repeat steps again until I print all the letters out for all the clients.

Instead what I would like to do is,
Create a word document of say 50 pages (if 50 clients retreived from db) and then send to print job.

Here is my code

'Loop the dataset
For Each oRow In dsMailList.Tables("Results").Rows

'Start Word and open the document template.
oWord = CreateObject("Word.Application")
oWord.Visible = True
oDoc = oWord.Documents.Add(strtemplate)

' Location of Word template; could be on a shared LAN
strtemplate = fname

oDoc = oWord.Documents.Add(strtemplate)

'Loop the Select Label List to get the values
For i = 0 To chkMailList.CheckedItems.Count - 1

strTest = oRow(chkMailList.CheckedItems(i))

strField = chkMailList.CheckedItems(i)

'strField = oWord.ActiveDocument.Bookmarks.Item(counter)

oWord.ActiveDocument.Bookmarks.Item(strField).Select()
oWord.Selection.TypeText(CStr(strTest))

Next i
oWord.PrintOut(False)

'oWord.PrintOut(Background:True)

CType(oWord, Word._Application).Quit(0)
Next

---------------------------------------------------------------------------------

Don't get confused with my inner loop becuse I give user an option what fields to select and bring corresponding data from the db. So inner loop is basically looping for checkedlist box.

Secondly, I heard something about DDE, to pass data using DDE for Windows Application, please shed some light on it if possible.

I'm sorry for this long content, any help would be really appreciative.

Thanks

[stingrae]

here's a version that i created in VB6. It should put you on the right track. Notice the Dim wrdMailMerge as Word.MailMerge object. This will help.

Private Sub cmdMerge_Click()
    Dim sSQLStm As String
    Dim recClients As New ADODB.Recordset
    Dim iField As Integer
    Dim wrdSelection As Word.Selection
    Dim wrdMailMerge As Word.MailMerge
    Dim wrdMergeFields As Word.MailMergeFields
    Dim wrdRange As Word.Range
    Dim iCR As Integer
    
    On Error GoTo errcmdMerge_Click
    
    If ValidateForm = False Then Exit Sub
    Screen.MousePointer = vbHourglass
    sSQLStm = "SELECT tbl_ClientMaster.* " & _
                 "" & _
              "FROM tbl_TempWorkTable INNER JOIN tbl_ClientMaster " & _
                                            "ON tbl_TempWorkTable.tmp_ClientID = tbl_ClientMaster.clm_ClientID " & _
              "WHERE (tbl_TempWorkTable.tmp_UserID = " & glUserID & ")"
    recClients.Open sSQLStm, gconDatabase, adOpenKeyset, adLockPessimistic, adCmdText
    If (recClients.BOF) Or (recClients.EOF) Then
        Beep
        StatusBar1.Panels(1).Text = "No records found!"
        Screen.MousePointer = vbDefault
        Set recClients = Nothing
        Exit Sub
    End If
    If optCSV.Value = True Then
        StatusBar1.Panels(1).Text = "Exporting data ... please wait"
        Open txtCSVOutput.Text For Output As #1
        For iField = 0 To recClients.Fields.Count - 1
            Print #1, DelimiterCheck(recClients.Fields(iField).Name) & ", ";
        Next iField
        Print #1, " "
        Do Until (recClients.BOF) Or (recClients.EOF)
            For iField = 0 To recClients.Fields.Count - 1
                Print #1, recClients.Fields(iField).Value & ", ";
            Next iField
            Print #1, " "
            recClients.MoveNext
        Loop
        Close #1
        ShellExecute Me.hwnd, "open", txtCSVOutput.Text & vbNullChar, "", 0, SW_SHOWNORMAL
        StatusBar1.Panels(1).Text = "Extract Complete"
    Else
        ' Create an instance of Word
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = False
        Set wrdDoc = wrdApp.Documents.Open(txtMMTemplate.Text)
        Set wrdSelection = wrdApp.Selection
        Set wrdMailMerge = wrdDoc.MailMerge
        Set wrdMergeFields = wrdMailMerge.Fields
        wrdDoc.SpellingChecked = False
        
        wrdSelection.Font.Name = cboFont.Text
        wrdSelection.Font.Size = txtFontSize.Text
        If chkDontCreateMergeFields.Value = vbUnchecked Then
            For iCR = 1 To txtBlankTop.Text
                wrdSelection.TypeParagraph
            Next iCR
            If chkDate.Value = vbChecked Then
                wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
                wrdSelection.InsertDateTime "dd MMMM yyyy"
                wrdSelection.TypeParagraph
            End If
            For iCR = 1 To txtBlankDate.Text
                wrdSelection.TypeParagraph
            Next iCR
            wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            If chkFullName.Value = vbChecked Then
                wrdMergeFields.Add wrdSelection.Range, "ClientName"
                wrdSelection.TypeParagraph
            End If
            If chkAddress.Value = vbChecked Then
                wrdMergeFields.Add wrdSelection.Range, "Address"
                wrdSelection.TypeParagraph
            End If
            If chkSuburb.Value = vbChecked Then
                wrdMergeFields.Add wrdSelection.Range, "Suburb"
                wrdSelection.TypeText " "
                'wrdSelection.TypeParagraph
            End If
            If chkState.Value = vbChecked Then
                wrdMergeFields.Add wrdSelection.Range, "State"
                wrdSelection.TypeText " "
                'wrdSelection.TypeParagraph
            End If
            If chkPostcode.Value = vbChecked Then
                wrdMergeFields.Add wrdSelection.Range, "Postcode"
                'wrdSelection.TypeParagraph
            End If
            For iCR = 0 To txtBlankAddress.Text
                wrdSelection.TypeParagraph
            Next iCR
            If chkDear.Value = vbChecked Then
                wrdSelection.TypeText "Dear "
                wrdMergeFields.Add wrdSelection.Range, "Dear"
                wrdSelection.TypeParagraph
            End If
            For iCR = 1 To txtBlankDear.Text
                wrdSelection.TypeParagraph
            Next iCR
        End If
        
        CreateMailMergeDataFile
        
        If optEmail.Value = True Then
            wrdMailMerge.MailAddressFieldName = "Email"
            wrdMailMerge.MailSubject = txtEmailSubject.Text
            wrdMailMerge.Destination = wdSendToEmail
        End If
        
        wrdMailMerge.Execute True
        wrdDoc.Close False
        
        Kill gcWorkFile
        
        Set wrdSelection = Nothing
        Set wrdMailMerge = Nothing
        Set wrdMergeFields = Nothing
        Set wrdDoc = Nothing
        Set wrdApp = Nothing
        StatusBar1.Panels(1).Text = "Merge Complete"
    End If
    recClients.Close
    
    Screen.MousePointer = vbDefault
    Exit Sub
errcmdMerge_Click:
    Dim yn As VbMsgBoxResult
    yn = MsgBox("An unexpected error has occurred during the mail merge." & vbCrLf & _
                 "The Error number is " & Err.Number & " and the error description is: " & _
                 Err.Description & vbCrLf & vbCrLf & _
                 "What do you wish to try again, skip or exit?" & vbCrLf & vbCrLf & _
                 "Yes = Try Again " & vbCrLf & _
                 "No = Skip " & vbCrLf & _
                 "Cancel = Cancel the function ", vbQuestion + vbYesNoCancel, "Error - frmClientQuery.cmdMerge")
    If yn = vbYes Then
        Resume
    ElseIf yn = vbNo Then
        Resume Next
    Else
        Screen.MousePointer = vbDefault
    End If
End Sub

[stingrae]

and here's two more subroutines that you will need.

Public Sub CreateMailMergeDataFile()
    Dim wrdDataDoc As Word.Document
    Dim iCount As Integer
    Dim l As Integer
    Dim sSQLConsultant As String
    Dim recMM As New ADODB.Recordset
    Dim cmdMM As New ADODB.Command
    Dim sDear As String
    Dim sInternal As String
    Dim sSQLStm As String
    
    ProgressBar1.Value = 0
    ProgressBar1.Visible = True
    sSQLStm = "SELECT tbl_TempWorkTable.*, tbl_ClientMaster.*, " & _
                     "IIf(IsNull(tbl_ClientMaster.clm_Title),'',tbl_ClientMaster.clm_Title)+' '+tbl_ClientMaster.clm_First+' '+tbl_ClientMaster.clm_Last AS ClientName " & _
              "FROM (tbl_TempWorkTable INNER JOIN tbl_ClientMaster " & _
                                             "ON tbl_TempWorkTable.tmp_ClientID = tbl_ClientMaster.clm_ClientID) " & _
              "WHERE (tbl_TempWorkTable.tmp_UserID = " & glUserID & ")"
    Debug.Print sSQLStm
    recMM.Open sSQLStm, gconDatabase, adOpenKeyset, adLockPessimistic, adCmdText ' adOpenStatic
    If recMM.RecordCount > 0 Then ProgressBar1.Max = recMM.RecordCount
    
    wrdDoc.MailMerge.CreateDataSource Name:=gcWorkFile, _
          HeaderRecord:="ClientName, Title, First, Last, Dear, Address, Suburb, State, Postcode, Email"
    
    Set wrdDataDoc = wrdApp.Documents.Open(gcWorkFile) ', , , , , , , , , wdOpenFormatText ,)
    wrdDataDoc.SpellingChecked = False
    Do Until (recMM.BOF) Or (recMM.EOF)
        wrdDataDoc.Tables(1).Rows.Add
        If (optLetters.Value = True) _
        Or (optEmail.Value = True And Trim(StrNull(recMM.Fields("clm_Email"))) <> "") Then
            FillRow wrdDataDoc, wrdDataDoc.Tables(1).Rows.Count - 1, _
                    StrNull(recMM.Fields("ClientName")), _
                    StrNull(recMM.Fields("clm_Title")), _
                    StrNull(recMM.Fields("clm_First")), _
                    StrNull(recMM.Fields("clm_Last")), _
                    recMM.Fields("clm_First"), _
                    StrNull(recMM.Fields("clm_Address")), _
                    StrNull(recMM.Fields("clm_Suburb")), _
                    StrNull(recMM.Fields("clm_State")), _
                    StrNull(recMM.Fields("clm_Postcode")), _
                    StrNull(recMM.Fields("clm_Email"))
        End If
        recMM.MoveNext
        
        ProgressBar1.Value = ProgressBar1.Value + 1
        DoEvents
    Loop
    recMM.Close
    ' Save and close the file
    wrdDataDoc.Save
    wrdDataDoc.Close False
    ProgressBar1.Visible = False
    Exit Sub
    
errCreateMailMergeDataFile:
    Dim yn As VbMsgBoxResult
    yn = MsgBox("An unexpected error has occurred during the mail merge." & vbCrLf & _
                 "The Error number is " & Err.Number & " and the error description is: " & _
                 Err.Description & vbCrLf & vbCrLf & _
                 "What do you wish to try again, skip or exit?" & vbCrLf & vbCrLf & _
                 "Yes = Try Again " & vbCrLf & _
                 "No = Skip " & vbCrLf & _
                 "Cancel = Cancel the function ", vbQuestion + vbYesNoCancel, "Error - frmClientQuery.CreateMailMergeDataFile")
    If yn = vbYes Then
        Resume
    ElseIf yn = vbNo Then
        Resume Next
    Else
        Screen.MousePointer = vbDefault
    End If

End Sub

Private Sub FillRow(Doc As Word.Document, Row As Integer, _
                  ClientName As String, Title As String, _
                  First As String, Last As String, _
                  Dear As String, _
                  Address As String, Suburb As String, _
                  State As String, _
                  Postcode As String, Email As String)
    With Doc.Tables(1)
        ' Insert the data into the specific cell
        .Cell(Row, 1).Range.InsertAfter ClientName
        .Cell(Row, 2).Range.InsertAfter Title
        .Cell(Row, 3).Range.InsertAfter First
        .Cell(Row, 4).Range.InsertAfter Last
        .Cell(Row, 5).Range.InsertAfter Dear
        .Cell(Row, 6).Range.InsertAfter Address
        .Cell(Row, 7).Range.InsertAfter Suburb
        .Cell(Row, 8).Range.InsertAfter State
        .Cell(Row, 9).Range.InsertAfter Postcode
        .Cell(Row, 10).Range.InsertAfter Email
    End With
End Sub

[score]

Thanks for prompt reply.

I did tried this example but my app craps out when it come to the line wrdDoc.MailMerge.CreateDataSource Name.

I says either my SQL string is too long (advise to use DDE, which I have no idea or reduce SQL string) OR change some registry settings.

Another thing I notice that you are creating table and rows but in my template there no rows, it's like this

Dear <firstname> <lastname>
<title>
<address>

Letter Content
blah blah blah

Thanks

And it should be repeated or duplicated as many number of times I get the records retrieved from db for each contact.

thanks

[score]

Hi, I'm trying to work with your code, what's gcWorkfile parameter for, where is it getting value from.

Thanks

[stingrae]

Score,

the value gcWorkFile is the file that stores all the data. What happens is that I create a word doc with a table in it and place all the names and addresses into this file.

I have this file declared as:

Global Const gcWorkFile = "C:\TempWorkFile.doc"

The first row of the table contain the field names:

wrdDoc.MailMerge.CreateDataSource Name:=gcWorkFile, _
          HeaderRecord:="ClientName, Title, First, Last, Dear, Address, Suburb, State, Postcode, Email"

To view this file, simply comment out the line that deletes this file (Kill gcWorkFile).

let me know how you go.

[score]

Thanks stingrae,
I got it working yesterday finally, phew!!!

I give user an option to select the fields for the data required from db and also to select the word template for which they would lile to perform the mail merge. It's kinda neat, everything works fine now.

Again thanks for the start. Here is the final code for mail merge in Vb.net that I eneded up with

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Try
Dim i As Integer

Dim strSelectMail As String
Dim clsDatabase As New clsDatabase()
Dim myStream As Stream
Dim openFileDialog1 As New OpenFileDialog()
Dim fname As String
Dim oRow As DataRow
Dim newFileName As String
Dim strTest As String
Dim strtemplate As String
Dim strField As String
Dim wrdSelection As Word.Selection
Dim wrdMailMerge As Word.MailMerge
Dim wrdMergeFields As Word.MailMergeFields


'Looping through the checked list box to get the field names
If chkMailList.CheckedItems.Count > 0 Then
For i = 0 To chkMailList.CheckedItems.Count - 1
If i <> chkMailList.CheckedItems.Count - 1 Then
strMailList = strMailList & chkMailList.CheckedItems(i) & ","
Else
strMailList = strMailList & chkMailList.CheckedItems(i)
End If
Next i

i = 0

'Formatting the SQL Select statement
strSelectMail = "Select " & strMailList & " from Contacts where ID IN ( " & strContact & " )"

'Getting the data from the db and filling in the dataset
dsMailList = clsDatabase.LoadSearchDataSet(CONN, strSelectMail)

'Make sure thers is data
If dsMailList.Tables("Results").Rows.Count > 0 Then

'Call the open file dialog box to select the Mail Merge file
openFileDialog1.InitialDirectory = "p:\"
openFileDialog1.Filter = "doc files (*.doc)|*.doc"
openFileDialog1.FilterIndex = 2
openFileDialog1.RestoreDirectory = True

If openFileDialog1.ShowDialog() = DialogResult.OK Then
myStream = openFileDialog1.OpenFile()

'Get the path and file name
fname = openFileDialog1.FileName
' MsgBox(fname)
If Not (myStream Is Nothing) Then
' Insert code to read the stream here.
myStream.Close()
End If

Else

Exit Sub

End If

' Location of Word template; could be on a shared LAN
strtemplate = fname

'******************************************************
'Start of Word Mail Merge

'Make Mouse Pointer Busy
Cursor.Current = System.Windows.Forms.Cursors.AppStarting


' Create an instance of Word and make it visible.
wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

' Open the Mail Merge Document
wrdDoc = wrdApp.Documents.Open(fname)
wrdDoc.Select()

wrdSelection = wrdApp.Selection()
wrdMailMerge = wrdDoc.MailMerge()

'Prepare the data file
CreateMailMergeDataFile()

' Perform mail merge.
wrdMergeFields = wrdMailMerge.Fields()

wrdMailMerge.Destination = _
Word.WdMailMergeDestination.wdSendToNewDocument
wrdMailMerge.Execute(False)

' Close the original form document.
wrdDoc.Saved = True
wrdDoc.Close(False)

' Release References.
wrdSelection = Nothing
wrdMailMerge = Nothing
wrdMergeFields = Nothing
wrdDoc = Nothing
wrdApp = Nothing

' Clean up temp file.
System.IO.File.Delete("C:\DataDoc.doc")

MsgBox("Mail Merge has successfully compeleted", MsgBoxStyle.Information, "Mail Merge")

'Make Mouse Pointer Normal
Cursor.Current = System.Windows.Forms.Cursors.Default

End If
Else
MsgBox("Please select field(s) from the list box for Mail Merge", MsgBoxStyle.OKOnly, "Mail Merge")
End If

Catch
If Err.Number = "5941" Then
MsgBox("The fields you have selected for Mail Merge does not correspond with the word template" & _
vbCrLf & "Please close the word document and perform Mail Merge", MsgBoxStyle.Exclamation, "InValid Fields")
Else
UnhandledExceptHandler()
End If


End Try

End Sub

Public Sub CreateMailMergeDataFile()
Dim wrdDataDoc As Word._Document
Dim oRow As DataRow
Dim strTest As String
Dim strField As String
Dim i As Integer
Dim iCount As Integer
Dim iRow As Integer
Dim iCell As Integer

'Intialize the data row in word document
'After creating the header the first rows gets created by default
'Therefore the next row would be number 2
iRow = 2

'Creating the datasource with all the fields selected from the list box
wrdDoc.MailMerge.CreateDataSource(Name:="C:\DataDoc.doc", _
HeaderRecord:=strMailList)

'Open the datasource
wrdDataDoc = wrdApp.Documents.Open("C:\DataDoc.doc") ', , , , , , , , , wdOpenFormatText ,)


'Create number of Rows based on number records retreived from DB
For iCount = 2 To dsMailList.Tables("Results").Rows.Count
wrdDataDoc.Tables.Item(1).Rows.Add()
Next iCount


'Loop the dataset and insert the data into the word table
For Each oRow In dsMailList.Tables("Results").Rows
'Intailze the first cell
iCell = 1

'Loop the Select Label List to get the values and on the respective cell
For i = 0 To chkMailList.CheckedItems.Count - 1

strTest = oRow(chkMailList.CheckedItems(i))
FillRow(wrdDataDoc, iRow, iCell, strTest)

'Go to next cell
iCell = iCell + 1

Next i

'Go to Next row
iRow = iRow + 1

Next



' Save and close the file
wrdDataDoc.Save()
wrdDataDoc.Close(False)

Exit Sub

errCreateMailMergeDataFile:

MsgBox("An unexpected error has occurred during the mail merge." & vbCrLf & _
"The Error number is " & Err.Number & " and the error description is: " & _
Err.Description & vbCrLf & vbCrLf & _
"What do you wish to try again, skip or exit?" & vbCrLf & vbCrLf & _
"Yes = Try Again " & vbCrLf & _
"No = Skip " & vbCrLf & _
"Cancel = Cancel the function ", vbQuestion + vbYesNoCancel, "Error - frmClientQuery.CreateMailMergeDataFile")

End Sub

Private Sub FillRow(ByVal Doc As Word.Document, ByVal Row As Integer, ByVal iCell As Integer, ByVal strData As String)

With Doc.Tables.Item(1)
' Insert the data into the specific cell
.Cell(Row, iCell).Range.InsertAfter(strData)
End With

End Sub

[stingrae]

cool, that looks neat.

glad i could help.