?
Solved

(UPDATE) Simple VB-Word Questions, no longer Visual Basic 6.0 Mail Merge

Posted on 2006-04-16
6
Medium Priority
?
294 Views
Last Modified: 2012-05-05
[UPDATE] Read Comment I have below for my final question.  I bet this will be very easy for someone, as I now have the mail merge working fine.  I just have one small problem

I have been trying to solve this for some time now but have been unable to come up with or find a solution.  Basically, I have a VB 6 program I'm writing that when the user clicks a Command Button would open a mail merged document.  To give an example of what I'm doing I created three files.

http://www.missouri.edu/~njc2b5/question/test.mdb
http://www.missouri.edu/~njc2b5/question/OriginalDoc.doc
http://www.missouri.edu/~njc2b5/question/FinalDoc.doc

Basically I have a table in my database which contains a list of names.  I have already created the template document and linked the data in word through the Original Document.  My goal was that when the user click the Comman Button in the VB 6 app that it would take the OriginalDoc.doc and create the FinalDoc.doc by merging to a new document. It really doesn't have to save the final merged document, and infact if it just opened it that would be great, because the user could then save it themselves whereever they wanted.

So far I have had no luck.  Below is the most recent code I've been working with.  Can anyone assist me with this?  Thank you very much for your time.

Below is my current VB Code


Dim WithEvents oApp As Word.Application
Option Explicit

Private Sub cmdMerge_Click()
   
    Dim test_app As Word.Document
   
    Screen.MousePointer = vbHourglass
    DoEvents
   
    Dim Path As String
    Path = App.Path & "\OriginalDoc.doc"
     
    Set test_app = oApp.Documents.Open(Path)
   
    With ActiveWindow
            .MailMerge.Destination = Word.wdSendToNewDocument
            .MailMerge.SuppressBlankLines = True
            With .MailMerge.DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .MailMerge.Execute Pause:=False
        Windows("OriginalDoc.doc").Activate
        ActiveWindow.Close
    End With
       
    Screen.MousePointer = vbDefault
   
End Sub
0
Comment
Question by:nconfer
  • 4
5 Comments
 
LVL 1

Author Comment

by:nconfer
ID: 16503912
Is anyone able to offer some assistance?  I would really appreciate it.
0
 
LVL 1

Author Comment

by:nconfer
ID: 16517817
Alright, after about a week of work I have something very close to a solution.  The code below opens a word document that is completely empty called New.doc.  It then opens the OriginalDoc.doc to paste records in for every row of data.  Once it is done it saves to FinalDoc.com.

So, IT WORKS!  Excpet one small problem.  My header line to my document reads Mail Merge Test with Visual Basic 6

but when I get the final document it reads MMail Merge Test with Visual Basic 6 and my last page (or last row added to the doc reads) ail Merge Test with Visual Basic 6.  So for some reason I have an added letter at the beginning that is missing in the last page of my doc.  I'm thinking this has to do with where VB is telling the document to paste the OriginalDoc.doc for each row.  Can someone tell me how to fix this.  Its probably a one line fix.  Also, I have an extra page at the end of the Document because of a pagebreak.  Is there any way to get rid of this (if you don't know the page break part its not important, I can live with printing one blank page).

I greatly appreciate it, and am still willing to give the 500 points for help here.


Below is my working code... with the single character problem


Option Explicit
Dim AConnection As New ADODB.Connection
Dim ARecordset As New ADODB.Recordset

Private Sub Command1_Click()
    Merge_Data App.Path & "\OriginalDoc.doc", ARecordset
End Sub


Sub Merge_Data(sMergeDoc As String, rRecords As ADODB.Recordset)
    'This Routines intakes a mail merge docu
    '     ments path and a Queries Recordset merge
    '     s
    'the two, then output's a user defined l
    '     etter. This Routine Requires that Micors
    '     oft
    'Word 8.0 Object library and ADO 2.x are
    '     referenced
    Dim loGlobVar As New Word.Global
    Dim Nc As Integer
    Dim liPos As Integer
    Dim lsFieldName As String
    Dim lsaFldNames() As String


    If Not rRecords.EOF Then
        rRecords.MoveFirst

        Dim xWORD As Object
        Set xWORD = CreateObject("Word.Application")
        xWORD.Documents.Open App.Path & "\New.doc"
       
        rRecords.MoveLast

        While Not rRecords.BOF
           
            xWORD.Selection.Start = 1
           
            xWORD.Selection.InsertFile FileName:=sMergeDoc
           
            'Open Array Space for the Documents Mail
            '     Merge Field Names
           
            ReDim lsaFldNames(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields.Count)
           
           
            'Get the mail merge field names for use


            '     with the recordset

                For Nc = 1 To xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields.Count
                    lsFieldName = Trim(Right(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(Nc).Code, Len(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(Nc).Code) - 11))
                    lsaFldNames(Nc - 1) = lsFieldName
                Next Nc

               
                'Write the data from the record set to t
                '     he corresponding locations in the docume
                '     nt.
                'Since the MailMerge Field is removed on
                '     ce text is written in its place, using t
                '     he
                'index of 1 moves you through the field
                '     locations.


                    xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(1).Select
                    'Use the Mail Merge field names to call
                    '     the corresponding recordset column by na
                    '     me.
                    loGlobVar.Selection.TypeText rRecords("id")
                    xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(1).Select
                    loGlobVar.Selection.TypeText rRecords("name")
                   
                    Selection.InsertBreak Type:=wdPageBreak

                    xWORD.Selection.End = 0
                   
                   
                rRecords.MovePrevious
            Wend
           
            'Close Recordset
            rRecords.Close
        End If
        xWORD.Documents(App.Path & "\New.doc").SaveAs (App.Path & "\FinalDoc.doc")
       
        xWORD.Quit
        Set xWORD = Nothing
       
        Set rRecords = Nothing
    End Sub


Private Sub Form_Load()
On Error GoTo ErrorHandler
' Connect to database -
AConnection.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;data source=" & App.Path & "\test.mdb;"
AConnection.CursorLocation = adUseClient
AConnection.Open
' Open the 'Customers' table -
ARecordset.Open "Select * from test", AConnection, adOpenDynamic, adLockOptimistic
Exit Sub
' Error message -
ErrorHandler:
MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "The program will now close.", vbOKOnly, "Error!"
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
' Close the connection when the form is closed -
AConnection.Close
Set AConnection = Nothing
End Sub
0
 
LVL 1

Author Comment

by:nconfer
ID: 16517876
I solved it.  I now have it working perfectly.  Thanks for anyone who read my post and wanted to help.

Sub Merge_Data(sMergeDoc As String, rRecords As ADODB.Recordset)
    Dim loWordApp As New Word.Application
    Dim loDoc As New Word.Document
    Dim loGlobVar As New Word.Global
    Dim Nc As Integer
    Dim liPos As Integer
    Dim lsFieldName As String
    Dim lsaFldNames() As String


    If Not rRecords.EOF Then
        rRecords.MoveFirst

        Dim xWORD As Object
        Set xWORD = CreateObject("Word.Application")
        xWORD.Documents.Open App.Path & "\New.doc"
       

        Dim StopAt As Integer
        Dim RecordsCount As Integer
        RecordsCount = 1
        StopAt = rRecords.RecordCount

        While Not rRecords.EOF
            xWORD.Selection.InsertFile sMergeDoc
            If (RecordsCount + 1 <= StopAt) Then Selection.InsertBreak Type:=wdPageBreak
            rRecords.MoveNext
            RecordsCount = RecordsCount + 1
        Wend
       
        rRecords.MoveFirst

        While Not rRecords.EOF
                       
            ReDim lsaFldNames(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields.Count)
           
                For Nc = 1 To xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields.Count
                    lsFieldName = Trim(Right(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(Nc).Code, Len(xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(Nc).Code) - 11))
                    lsaFldNames(Nc - 1) = lsFieldName
                Next Nc


                    xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(1).Select
                    loGlobVar.Selection.TypeText rRecords("id")
                    xWORD.Documents(App.Path & "\New.doc").MailMerge.Fields(1).Select
                    loGlobVar.Selection.TypeText rRecords("name")
                   
                   
                rRecords.MoveNext
            Wend
           
           
            rRecords.Close
        End If
       
        xWORD.Documents(App.Path & "\New.doc").SaveAs (App.Path & "\FinalDoc.doc")
       
        xWORD.Selection.HomeKey Unit:=wdStory
        xWORD.Visible = True
               
        Set rRecords = Nothing
    End Sub
0
 
LVL 1

Author Comment

by:nconfer
ID: 16520916
Sounds good, thank you for responding to my request so quickly
0
 

Accepted Solution

by:
GranMod earned 0 total points
ID: 16553972
Closed, 500 points refunded.
GranMod
The Experts Exchange
Community Support Moderator of all Ages
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month14 days, 23 hours left to enroll

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question