mailmerge 1

[DTSFreak]

Hi,

Can somebody help me with my code? I would like to do a mailmerge through
document properties, which i've created in word.

I'm using a continueous form in access and a commandbutton to do a
mailmerge.
I can manage it to do it for one record, but not for multiple records.

This is what i would to do:

- if someone wants to merge 1 record then the code should call word, by
using document properties or variables and create a document based on the template.

-if all or a selection of records has been choosen then it should do like above, but then reproduce the same document in one file (otherwise they have to print all documents separatelately, rather then just press print).

Here's my code:

On Error GoTo ErrorHandler

Dim appWord As Word.Application
Dim docs As Word.Documents
Dim strLetter As String
Dim strTemplateDir As String
Dim prps As Object
Dim strDate As String

Set appWord = GetObject(, "Word.Application")
strDate = CStr(Date)

strTemplateDir = appWord.Options.DefaultFilePath(wdUserTemplatesPath)
strTemplateDir = strTemplateDir & "\"

'Debug.Print "Office templates directory: " & strTemplateDir

strLetter = strTemplateDir & "DocProps.dot"
'Debug.Print "Letter: " & strLetter

Set docs = appWord.Documents
docs.Add strLetter

Set prps = appWord.ActiveDocument.CustomDocumentProperties

'There should be a way to reference the prps in a for each control in my
form, but i don't know how to do it. So it did it like this.
With prps
.Item("TodayDate").Value = strDate
.Item("Address").Value = Nz(Me![txtAddress])
.Item("Salutation").Value = Nz(Me![txtSalutation])
.Item("CompanyName").Value = Nz(Me![txtCompanyName])
.Item("City").Value = Nz(Me![txtCity])
.Item("StateProv").Value = Nz(Me![txtStateOrProvince])
.Item("PostalCode").Value = Nz(Me![txtPostalCode])
.Item("JobTitle").Value = Nz(Me![txtTitle])
End With

With appWord
.Visible = True
.Activate
.Selection.WholeStory
.Selection.Fields.Update
.Selection.MoveDown Unit:=wdLine, Count:=1
End With

ErrorHandlerExit:
Exit Sub

ErrorHandler:
If Err = 429 Then
'Word is not running; open Word with CreateObject
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If

So if anyone can adjust or improve my code, I would be very happy.

 

[SpectacledBear]

Hi, I'm not too good with code, but you could an alternative method. if you dont want to, thats fine, but this way is easier.

Create a query which would grab all the info you need, (you'd probably need to enter somethin in the criteria of at least one of the fields), then open your mail merge document, click on the button that looks like a little table to find the data source, then locate your database. Click ok and ok again, then choose the mail merge query. press the <<abc>> button on the ail merge toolbar to see your data in the mail merge. there is a small record selector on the toolbar which allows you to view the next record etc.

Once you save the document after finding the data source, you wont have to do it the next time.

As for opening the document straight from access, it's simple. click the hyperlink button (a globe with a chain in front of it) and find your document. Create a name for the hyperlink (eg Mail Merge)and whenever this is pressed the doucment will open with the correct data gathered by your query.

You can also assign hyperlinks to command buttons if the look of a straightforward hyperlink isn't consistent with your theme.

Let me know if this helps!

 

[apestaart]

Hi,

When the result of the query is just one record, it is not possible to select the query from the DataSources list in Word. It does not appear in the list. If you want to print a mailmerge document direct from a ACCESS Form with a query looking at the criteria ID = [Forms]![NameForm]![ID].
How can I then print just one document??

Best regard,

Gerard van Beek

 

[Remou]

Hi
I think I might approach this a different way. If your Word template was linked to a query or a CSV file that you built based on your users selection, all you would have to do is build the query / text file, open your word template and run the mail merge using automation.
(I do not find I have a problem linking to a query with only one record.)
.ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\MyMDB.mdb", LinkToSource:=True, Connection:="QUERY MyQuery", SQLStatement:= _
"SELECT * FROM [MyQuery]"

 

[apestaart]

Hi Remou,

I Don't understand the VB code you have suggested.
What I want to do is the following:
I Filter data from a Table, that results in one record.
I make that record visable via a Form.
On that Form I have a button for creating a report.
I that report I use the variables from the filtered record.
As you know it is not easy to position variable text into the maintext of a report.
So Iam looking for a way to use a predefined Word document with variable fields.

Pressing the button should open the Word document and fill the fields.

I can do this in the way discribed above, but only for multiple records, not just one. (not in the list, see my previous message)

Can you help me.

Regards,

Gerard van Beek

 

[larsen18]

Hi
TAke a look here

http://www.helenfeddema.com/,

I think you will find the answers to your problem

Arild

 

[Remou]

Hi
This is what I was talking about. It is an outline, there is no error coding etc, etc.

'======================
Option Compare Database
Option Explicit
'======================
Sub CreateMailMerge()
Dim oApp As Object
Dim strTemplate

strTemplate = CurrentProject.Path & "\OutputWord.dot"

If Not FileExists(strTemplate) Then
    Call BuildTemplate
End If

Call Create_OutputWord_Query
'Create incidence of word
Set oApp = CreateObject("Word.Application")
oApp.Visible = False 'True

'Create new document
oApp.Documents.Add Template:=CStr(strTemplate)
    With oApp.ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With


'Turn screen back on
oApp.Visible = True

'Activate document for typing
oApp.Activate
'Release reference
Set oApp = Nothing

End Sub
'======================
Sub Create_OutputWord_Query()
Dim dbs As Database
Set dbs = CurrentDb

If QueryExists("qryOutputWord") Then
    dbs.QueryDefs.Delete "qryOutputWord"
End If
    
dbs.CreateQueryDef "qryOutputWord", _
    "SELECT Members.Code, Members.Title, Members.FirstName, " _
    & "Members.LastName, Members.Address1, Members.Address2, " _
    & "Members.Address3 " _
    & "FROM Members " _
    & "WHERE (((Members.Code)<'CHL'));"
End Sub
'======================
Function QueryExists(strQueryName As String) As Boolean
    ' This procedure returns True or False depending on whether
    ' the Query named in strQueryName exists.
    Dim dbs As Database, qdf As QueryDef

    On Error Resume Next
    Set dbs = CurrentDb
    Set qdf = dbs.QueryDefs(strQueryName)
    If Err = 3265 Then
        ' Table does not exist.
        QueryExists = False
    Else
        ' Table exists.
        QueryExists = True
    End If
    Err = 0
End Function
'======================
Function FileExists(strPathName) As Boolean
'You need the vbDirectory bit or else when the search string
'is a directory you will not get a return. It's fine for files,
'too.

Dim strName
strName = Dir(strPathName, vbDirectory)    ' Retrieve the first entry.
If strName <> "" Then    ' Start the loop.
    FileExists = True
    'Debug.Print vName
Else
    FileExists = False
End If
End Function
'======================
Sub BuildTemplate()

    Dim oApp As Object
    Dim strDBPathName
    Dim strConnection
    Dim strSQLStatement
    Dim dbs As Database
    Dim strSavePath
    
    Set dbs = CurrentDb
    strDBPathName = Application.CurrentProject.FullName
    strConnection = "QUERY qryOutputWord"
    strSQLStatement = "SELECT * FROM [qryOutputWord]"
    strSavePath = CurrentProject.Path & "\OutputWord.dot"

    
    Set oApp = CreateObject("Word.Application")
    oApp.Visible = True
    With oApp
        .Documents.Add
        With .ActiveDocument
            .MailMerge.MainDocumentType = wdFormLetters
            .MailMerge.OpenDataSource Name:=strDBPathName, _
                ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
                AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
                WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
                Format:=wdOpenFormatAuto, Connection:=strConnection, SQLStatement _
                :=strSQLStatement, SQLStatement1:=""
            .MailMerge.EditMainDocument
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="Title"
            Selection.TypeText Text:=" "
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="FirstName"
            Selection.TypeText Text:=" "
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="LastName"
            Selection.TypeParagraph
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="Address1"
            Selection.TypeParagraph
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="Address2"
            Selection.TypeParagraph
            .MailMerge.Fields.Add Range:=Selection.Range, Name:="Address3"
        .SaveAs FileName:=strSavePath, _
            FileFormat:=wdFormatTemplate, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False
        End With
    End With
   oApp.Quit
   Set oApp = Nothing
End Sub

 

[apestaart]

Hallo All,

I tried to do it in the way of discribed by Hellen Feddema.
My listing is underneith and is equal with the code of DTSFreak. But I receive a Runtime Error '5': "Invalid procedure call or argument" in de first
.Item("TabRelatie_Plaats").Value = Nz(Me![Plaats])



Code :
Private Sub Command50_Click()


'I used code Written by Helen Feddema 4-22-98
'Last modified 8-2-2000

On Error GoTo ErrorHandler

Dim appWord As Word.Application
Dim docs As Word.Documents
Dim strLetter As String
Dim strTemplateDir As String
Dim prps As Object
Dim strDate As String
Dim strWordDoc As String

strWordDoc = Nz(Me![Document].Value)
MsgBox strWordDoc
Set ctl = Me![Document]
If strWordDoc = "" Then
MsgBox "Please select a document"
ctl.SetFocus
ctl.Dropdown
GoTo ErrorHandlerExit
End If


Set appWord = GetObject(, "Word.Application")
strDate = CStr(Date)
MsgBox ActiveDocument.Path & ActiveDocument.Name
' If AddIns.Count >= 1 Then MsgBox AddIns(1).Path
strTemplateDir = appWord.Options.DefaultFilePath(wdUserTemplatesPath)
MsgBox strTemplateDir
strTemplateDir = strTemplateDir & "\Personal Documents\"
Debug.Print "Office templates directory: " & strTemplateDir
strLetter = strTemplateDir & strWordDoc & ".dot"
Debug.Print "Letter: " & strLetter

Set docs = appWord.Documents
docs.Add strLetter

Set prps = appWord.ActiveDocument.CustomDocumentProperties
MsgBox "hier ben je geweest"
MsgBox Me![TabBedrijven Subform].Form![Naam bedrijf]

With prps
'.Item("Datum").Value = strDate
.Item("TabRelatie_Plaats").Value = Nz(Me![Plaats])
.Item("TabBedrijven_Naam_bedrijf").Value = Nz(Me![TabBedrijven Subform].Form![Naam bedrijf])
.Item("Name").Value = Nz(Me![txtFirstName] & " " & Me![TabBedrijven Subform].Form![Contactpersoon])
.Item("Address").Value = Nz(Me![Straat])
.Item("PostalCode").Value = Nz(Me![Postcode])
.Item("StateProv").Value = Nz(Me![txtStateOrProvince])
.Item("JobTitle").Value = Nz(Me![txtTitle])
.Item("Salutation").Value = Nz(Me![txtSalutation])
End With

With appWord
.Visible = True
.Activate
.Selection.WholeStory
.Selection.Fields.Update
.Selection.MoveDown Unit:=wdLine, Count:=1
End With

ErrorHandlerExit:
Exit Sub

ErrorHandler:
If Err = 429 Then
'Word is not running; open Word with CreateObject
Set appWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If



End Sub


What is going wrong?

Gerard van Beek