VBA dynamic email merge (1 Viewer)

[MHutcheson]

I have a Word 2010 document linked to an Access 2010 data source. When a user clicks a button in Access, the Word document loads and performs a email merge using the below VBA code:

Private Sub Document_Open()
With ActiveDocument.MailMerge
.Destination = wdSendToEmail
.SuppressBlankLines = True
.MailSubject = ActiveDocument.MailMerge.DataSource.DataFields("Return_code").Value
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord

End With
.Execute Pause:=False
End With
End Sub


However, as the .mailsubject part is not in the loop it is only retrieving the first Return Code. I have tried to integrate in the loop to no avail. Also, how do I add static text to the Subject, I need something like "Your Return Code" + "Return Code"

Thank you for any help.

Regards,

Michael

 

[JackKaptijn]

Have you the possibility of using an SMTP mail server?
Then I suggest you use CDO. I got an example for you...

 

[MHutcheson]

Thanks for the reply - yes I have access to an Exchange server. What is CDO?

 

[JackKaptijn]

CDO is a library which enables the possibility to mail directly using the SMTP server. This is in generally what you need to do (depending on the configuration of your SMTP server)

    Dim objMsg As Object
    Dim objConf As Object
    Dim flds As Variant
    
    Set objMsg = CreateObject("CDO.Message")
    Set objConf = CreateObject("CDO.Configuration")
    
    objConf.Load -1
    Set flds = objConf.Fields
    With flds
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpusessl[/URL]") = False
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpauthenticate[/URL]") = False
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpsendusername[/URL]") = "[EMAIL="noreply@domain.com"]noreply@domain.com[/EMAIL]"
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpsendpassword[/URL]") = ""
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "SMTPSERVERNAME"
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
        .Item("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
        .Update
    End With
    
    With objMsg
        Set .configuration = objConf
        .To = "[EMAIL="towho@domain.com"]towho@domain.com[/EMAIL]"
        .CC = ""
        .BCC = ""
        .FROM = "[EMAIL="isendit@domain.com"]isendit@domain.com[/EMAIL]"
        .Subject = "Subject"
        .HTMLBody = "The message"
        .addAttachment "c:\attachment.docx"
        .Send
    End With

 

[MHutcheson]

Hello,

Thank you for this.

I need to send from email addresses contained in an Access 2010 database and the mails need to appear as if they are only being sent to the sender and no one else. How would I configure the below code to do this?

Regards,

Michael

 

[JackKaptijn]

Lets say you have got a table customers with two field: name, email.
This code below sends all customers with an email adres a message:

Dim rstCustomer as Recordset
set rstCustomer = Currentdb.OpenRecordSet("Customer")
 
rstCustomer.Movefirst
 
Do while not rstCustomer.EOF And Not Isnull(rstCustomer!email)
[INDENT]SendMail (rstCustomer!email)
rstCustomer.Movenext
[/INDENT]Loop
 
Public Function SendMail(email as String)
    Dim objMsg As Object
    Dim objConf As Object
    Dim flds As Variant
    
    Set objMsg = CreateObject("CDO.Message")
    Set objConf = CreateObject("CDO.Configuration")
    
    objConf.Load -1
    Set flds = objConf.Fields
    With flds
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpusessl"]http://schemas.microsoft.com/cdo/con...ion/smtpusessl[/URL]") = False
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"]http://schemas.microsoft.com/cdo/con...tpauthenticate[/URL]") = False
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpsendusername"]http://schemas.microsoft.com/cdo/con...tpsendusername[/URL]") = "[EMAIL="noreply@domain.com"]noreply@domain.com[/EMAIL]"
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpsendpassword"]http://schemas.microsoft.com/cdo/con...tpsendpassword[/URL]") = ""
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpserver"]http://schemas.microsoft.com/cdo/con...ion/smtpserver[/URL]") = "SMTPSERVERNAME"
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/smtpserverport"]http://schemas.microsoft.com/cdo/con...smtpserverport[/URL]") = 25
        .Item("[URL="http://schemas.microsoft.com/cdo/configuration/sendusing"]http://schemas.microsoft.com/cdo/con...tion/sendusing[/URL]") = 2
        .Update
    End With
    
    With objMsg
        Set .configuration = objConf
        .To = email
        .CC = ""
        .BCC = ""
        .FROM = "[EMAIL="isendit@domain.com"]isendit@domain.com[/EMAIL]"
        .Subject = "Subject"
        .HTMLBody = "The message"
        .addAttachment "c:\attachment.docx"
        .Send
    End With
End Function

 

[MHutcheson]

Its ok, I finally got it working, here is the code:

Private Sub Document_Open()

Dim intSourceRecord
Dim objMerge As Word.MailMerge
Dim bTerminateMerge As Boolean

' If no data source has been defined, do it here using OpenDataSource.
' But if it is already defined in the document, you should not need to define it here.


' .OpenDataSource _
' Name:="whatever"

' Need to set up this object as the ActiveDocument changes when the
' merge is performed. Besides, it's clearer.

Set objMerge = ActiveDocument.MailMerge
With objMerge

' I don't use FirstRecord, LastRecord because they do not behave
' the way you expect in all data sources.

intSourceRecord = 1
bTerminateMerge = False

Do Until bTerminateMerge
.DataSource.ActiveRecord = intSourceRecord

' if we have gone past the end (and possibly, if there are no records)
' then the Activerecord will not be what we have just tried to set it to


If .DataSource.ActiveRecord <> intSourceRecord Then
bTerminateMerge = True
' the record exists
Else


.DataSource.FirstRecord = intSourceRecord
.DataSource.LastRecord = intSourceRecord
.Destination = wdSendToEmail

' set up the field containing the e-mail address
ActiveDocument.MailMerge.MailAddressFieldName = "EmailAddress"
' Set up the subject - make sure any field name in here has the same
' capitalisaiton as the name in the data source

.MailSubject = "Your Refund " & ActiveDocument.MailMerge.DataSource.DataFields("ReturnCode").Value
.Execute
intSourceRecord = intSourceRecord + 1
End If
Loop
End With
End Sub

Thank you for posting back to me though.

Michael