Needing some pointers here if possible ...
I have a successfully working section on a membership database system which merges word documents, creates the mail merge, and prints out the letters. All this works fine, and I attach below the programme etc that works.
There is a need however to potentially send out these letters or documents (or a similar version) to those members where we have an email address, and thus avoid postage costs etc. We are probably looking at approx. 500 members, (so not huge numbers)
What is the best way to achieve this, ideally, just operating it from a button on a form (as per the mail merge) so that the users do not need to go into the "back shop" of the Access workings. Is it possible to do something very similar using "Words" email function ?
Any guidance would be appreciated.
The current mail merge programme is as follows ...
Code:
Private Sub SetQuery(strQueryName As String, strSQL As String)
On Error GoTo ErrorHandler
'set the query from which the merge document will pull its info
Dim qdfNewQueryDef As QueryDef
Set qdfNewQueryDef = CurrentDb.QueryDefs(strQueryName)
qdfNewQueryDef.SQL = strSQL
qdfNewQueryDef.Close
RefreshDatabaseWindow
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred." & Err.Description, vbOKOnly, "Error"
Exit Sub
End Sub
Private Sub LapsedBttn_Click()
Dim qdf As DAO.QueryDef
Dim db As DAO.Database
Dim strSQL As String
Dim strDataSrc As String
Dim strTemplate As String
strDataSrc = "C:\Users\User5\Documents\LUCS\TestData.csv"
strTemplate = "C:\Users\User5\Documents\LUCS\Lapsed_Reminder.docx"
Set db = CurrentDb
strSQL = "SELECT Member_Names.Membership_Number, Member_Names.Status, Member_Names.First_Name, Member_Names.[Full Name], Member_Names.Membership_Class, Member_Names.[Address Line 1], Member_Names.[Address Line 2], Member_Names.Town, Member_Names.Region, Member_Names.Country, Member_Names.[Post Code], Member_Names.Last_Payment FROM Member_Names WHERE (((Member_Names.Membership_Number) Not Like 'H/*') AND ((Member_Names.Status)='Current') AND ((Member_Names.Membership_Class)<> 'Family (Member)' And (Member_Names.Membership_Class)<> 'Life') AND ((Year([Last_Payment]))<Year(Date())-1)) OR (((Member_Names.Membership_Number) Not Like 'H/*') AND ((Member_Names.Status)='Current') AND ((Member_Names.Membership_Class)<> 'Family (Member)' And (Member_Names.Membership_Class)<> 'Life') AND ((Member_Names.Last_Payment) Is Null))"
'set the query from which the merge document will pull its info
On Error Resume Next
With db
.QueryDefs.Delete ("qData")
On Error GoTo 0
Set qdf = .CreateQueryDef("qData", strSQL)
End With
Set qdf = Nothing
Set db = Nothing
'Create the csv from the query
DoCmd.TransferText acExportDelim, , "qData", strDataSrc, True
'Do the mail merge
Call fcnWordMergeMethod2(strTemplate, strDataSrc)
End Sub
Function fcnWordMergeMethod2(strWordTemplate As String, strDataSource As String)
On Error GoTo fcnWordMergeMethod2_Error
Dim strDocName As String
Dim wActiveDoc As Object
Dim appWord As Object
Dim wDoc As Object
Const wdDoNotSaveChanges = 0
Const wdSEndToNewDocument = 0
Const wdDialogMailMerge = 676
' Open a new mail merge document based on the selected template
Set appWord = GetObject(Class:="Word.Application")
'Close any existing open documents
For Each wDoc In appWord.Documents
wDoc.Close wdDoNotSaveChanges
Next wDoc
appWord.Documents.Add strWordTemplate
appWord.Visible = True
strDocName = appWord.ActiveDocument.Name
'Set the Merge Data source to the csv file and do the merge
With appWord
.Activate
.ActiveDocument.MailMerge.OpenDataSource Name:=strDataSource
.ActiveDocument.MailMerge.Destination = wdSEndToNewDocument
.ActiveDocument.MailMerge.Execute
.Dialogs(wdDialogMailMerge).Show
'Save the newly created merge document
'.ActiveDocument.SaveAs strSaveNamePath
'Close the master merge document
.Documents(strDocName).Close SaveChanges:=wdDoNotSaveChanges
End With
Set wActiveDoc = appWord.ActiveDocument
fcnWordMergeMethod2_Exit:
Exit Function
fcnWordMergeMethod2_Error:
Select Case Err
Case 429
Set appWord = CreateObject(Class:="Word.Application")
Resume Next
Case 4605, 5132
Resume Next
Case 5174
MsgBox "File " & strWordTemplate & " not found"
Case Else
MsgBox Err.Number & ", " & Err.Description & " Procedure fcnWordMergeMethod2" & " of basWordCode"
End Select
Resume fcnWordMergeMethod2_Exit
End Function