Best way to send out a batch email using VBA

[StuartR]

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 ...

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

[ranman256]

in Access:
docmd.SendObject acSendReport ,"rMyReport",acFormatPDF,sTo, ,,sSubj,sBody
or
docmd.SendObject acSendQuery ,"qsMyQuery",acFormatExcel,sTo,,,sSubj,sBody

[isladogs]

Also well worth looking at is the 'Super Easy Mail Merge' feature by Albert Kallal
http://www.kallal.ca/msaccess/msaccess.html
Many people including myself have used this successfully for many years - it really is easy to use

One word of warning - if you are sending out 500 emails, you may get issues with it being identified as junk email.
You may need to limit the numbers of emails sent per minute or use special software to do this for you

[StuartR]

in Access:
docmd.SendObject acSendReport ,"rMyReport",acFormatPDF,sTo, ,,sSubj,sBody
or
docmd.SendObject acSendQuery ,"qsMyQuery",acFormatExcel,sTo,,,sSubj,sBody

Ranman ~ Thanks for your quick response, much appreciated.

I have entered the following code, but I am getting a Runtime error 2293 cant send this email message. Any Clues ???

Private Sub Form_AfterUpdate()

Dim varName As Variant
Dim varCC As Variant
Dim varSubject As Variant
Dim varBody As Variant

varName = "ezine@lucs.org.uk"
varCC = "marketing@lucs.org.uk"
varSubject = "New Member"
varBody = "The following member has just joined the Society" & vbCrLf & Me.First_Name + " " + Me.Last_Name

DoCmd.SendObject acSendNoObject, , , varName, varCC, , varSubject, varBody, True, False


End Sub

[aytee111]

This seems to be related to new Outlook security measures and according to one only happens when Outlook is open (you could test this). There are other methods for sending emails in VBA, such as using SMTP which does not use Outlook.

[Micron]

Ridders52: have you tried that link lately? Seems something has moved.

new Outlook security measures

Not really. The problem arose about 14 years ago.
SturartR: There are work arounds listed here if you must use SendObject. I have used CDO in the past - might be a bit daunting for some.
Here's a list of limitations for the SendObject method that might make you change your mind (I'm not advocating the use of any solutions offered on this site)

[isladogs]

Ridders52: have you tried that link lately? Seems something has moved.
Not really. The problem arose about 14 years ago.
SturartR: There are work arounds listed here if you must use SendObject. I have used CDO in the past - might be a bit daunting for some.
Here's a list of limitations for the SendObject method that might make you change your mind (I'm not advocating the use of any solutions offered on this site)

I checked the link before posting.
The Access 2000(!) merge code link still works though the web page looks a couple of decades out of date....
However, I think other sites also have Albert's code
I have a version from around 2008 though no idea where I got it from

There's another interesting mil merge helper utility here http://www.gmayor.com/ManyToOne.htm

FWIW I also use CDO for sending email direct from Access apps and personally find it much easier to use than other methods