CDO Using a text file template (1 Viewer)

[mousemat]

Hi all.

I have CDO working well to send a test message to the recipients of a table (This will change later to an on demand query)

What I'd like to do is use a textfile template for the message which will be populated from the recordset.

What do I need to do with the code to make this work and is there anything special I need to do with the textfile in terms of placing the requisite data from the recordset?

Option Compare Database

Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
' Use basic (clear-text) authentication.
Const cdoBasic = 1
' Use NTLM authentication
Const cdoNTLM = 2 'NTLM

Public Sub SendEmail()
    Dim rs As DAO.Recordset

    Dim imsg As Object
    Dim iconf As Object
    Dim flds As Object
    Dim schema As String

    Set imsg = CreateObject("CDO.Message")
    Set iconf = CreateObject("CDO.Configuration")
    Set flds = iconf.Fields

    ' send one copy with SMTP server (with autentication)
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    flds.Item(schema & "sendusing") = cdoSendUsingPort
    flds.Item(schema & "smtpserver") = "serverdetails.co.uk"
    flds.Item(schema & "smtpserverport") = 25
    flds.Item(schema & "smtpauthenticate") = cdoBasic
    flds.Item(schema & "sendusername") = "me@home.com"
    flds.Item(schema & "sendpassword") = "12345780"
    flds.Item(schema & "smtpusessl") = False
    flds.Update

Set rs = CurrentDb.OpenRecordset("SELECT * FROM Customers") 'This is where the records come from, most likely a query run on demand

If Not (rs.EOF And rs.BOF) Then
    Do Until rs.EOF = True
        'On Error Resume Next
        With imsg
            .To = rs.Fields("Email")
            .From = """SENDER"" <XXX@somewhere.com>"
            .Subject = rs.Fields("Event")
            .TextBody = "Test Message"
            Set .Configuration = iconf
            .Send
        End With
        
        rs.MoveNext
    Loop
    
    Set iconf = Nothing
    Set imsg = Nothing
    Set flds = Nothing
    
End If

MsgBox "Finished looping through records, all emails have been sent."
rs.Close 'Close the recordset

End Sub

 

[theDBguy]

Hi. Are you asking how to read a text file using code?

 

[mousemat]

Basically yes, I want to load the textfile which has the body of the email message and also populate various parts of the message to make it personal to the reader

 

[theDBguy]

Basically yes, I want to load the textfile which has the body of the email message and also populate various parts of the message to make it personal to the reader

If so, you'll need placeholder text in your template to replace them with the data.

 

[mousemat]

I'm presuming thats something like .fieldname

How would I load it via the code given

 

[theDBguy]

I'm presuming thats something like .fieldname

How would I load it via the code given

Hi. Check out this article.

How to Read a Text File

Invariably, at one point or another in your journey to write VBA in Access, there will come a time when you will need to read the contents o...

thedbguy.blogspot.com

As for the placeholder text, maybe something like "<<customer name>>."

 

[mousemat]

Thanks for that, I'll have a play around and see if I can get to working

 

[theDBguy]

Thanks for that, I'll have a play around and see if I can get to working

You're welcome. Good luck! Let us know how it goes.

 

[mousemat]

Got it to send the text file. now just trying to sort the laceholders.

"<<customer name>>." just gives me "<<customer name>>."

 

[theDBguy]

Got it to send the text file. now just trying to sort the laceholders.

"<<customer name>>." just gives me "<<customer name>>."

Hi. The placeholders are there, so you can replace them with data. For example:

.Body = Replace(strBody,"<<customer name>>",rs!CustName)

 

[mousemat]

Hmm getting there slowly.

Ive added the Placeholders in the code, on separate lines and added the place holders to the text file but only getting the first placeholder populated.

If Not (rs.EOF And rs.BOF) Then
    Do Until rs.EOF = True
        'On Error Resume Next
        With imsg
            .To = rs.Fields("Email")
            .From = """SENDER"" <XXX@somewhere.com>"
            .Subject = rs.Fields("Event")
            .TextBody = BodyText
            .TextBody = Replace(BodyText, "<<Customer>>", rs!Customer)
            .TextBody = Replace(BodyText, "<<Event>>", rs!Event)
            .TextBody = Replace(BodyText, "<<Name>>", rs!Name)
            TextBody = Replace(BodyText, "<<Email>>", rs!Email)
            Set .Configuration = iconf
            .Send
        End With

Ive

 

[theDBguy]

Hmm getting there slowly.

Ive added the Placeholders in the code, on separate lines and added the place holders to the text file but only getting the first placeholder populated.

If Not (rs.EOF And rs.BOF) Then
    Do Until rs.EOF = True
        'On Error Resume Next
        With imsg
            .To = rs.Fields("Email")
            .From = """SENDER"" <XXX@somewhere.com>"
            .Subject = rs.Fields("Event")
            .TextBody = BodyText
            .TextBody = Replace(BodyText, "<<Customer>>", rs!Customer)
            .TextBody = Replace(BodyText, "<<Event>>", rs!Event)
            .TextBody = Replace(BodyText, "<<Name>>", rs!Name)
            TextBody = Replace(BodyText, "<<Email>>", rs!Email)
            Set .Configuration = iconf
            .Send
        End With

Ive

Yeah, instead of BodyText, use .TextBody in the Replace() lines.

 

[Isaac]

Try changing
these
.TextBody = Replace(BodyText, "<<Customer>>", rs!Customer)

to

.TextBody = Replace(.TextBody, "<<Customer>>", rs!Customer)

 

[mousemat]

Excellent. That's great. Many thanks for your help.

 

[theDBguy]

Excellent. That's great. Many thanks for your help.

No worries. We're here to help. Good luck with your project.