CDO Email, specific cells in the body

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
Hey all!

Is it possible to send email through SMTP server using CDO (no Outlook!) and insert specific cells in to the body of the email? I have functioning macro for sending emails, but I strugle with the body content. I would like to insert specific region in to the body of the email. Cells from columns A-N and from the last filled row. Is it possible? I can't figure out how to do it.

Thanks, Oxi.
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

paulxmw

Board Regular
Joined
Oct 13, 2015
Messages
88
Hi I Found this on Ron De Bruin's web site, it should get you going
1) Open a new workbook
2) Alt F11 (to open the VBA editor)
3) Insert>Module
4) Paste the code in this module
5) Make your changes
6) Alt q to go back to Excel

When you use Alt F8 you can select the macro and press Run.
Now wait a moment and see if you receive the mail in your inbox.
Sub CDO_Mail_Small_Text()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub Note: If you get this error : The transport failed to connect to the server
then try to change the SMTP port from 25 to 465
 

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
Hi,

I know this Ron's code. But I still can't figure out how to insert last row of the table in to the body. Now, my macro sends email when new record is made. But it would be great, if I could insert that record (last filled row of the table) in to the body of the email.
 

paulxmw

Board Regular
Joined
Oct 13, 2015
Messages
88
You could try inserting after the STR Body, this sorts the emails by email address currently set ti Column B and copies a range of cells from the rest of the sheet set to A up to H

Code:
'Set filter sheet, you can also use Sheets("Email text")
    Set Ash = ActiveSheet

    'Set filter range and filter column (column with e-mail addresses)
    Set FilterRange = Ash.Range("A1:H" & Ash.Rows.Count) ' this is the range it puts on the email, dont alter A but you can amend H
    FieldNum = 1    'Filter column =field name is where to get the email address from eg 1 column A 2 column B
                    'B because the filter range start in column A


    'Add a worksheet for the unique list and copy the unique list in A1
    Set Cws = Worksheets.Add
    FilterRange.Columns(FieldNum).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True


    'Count of the unique values + the header cell
    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
    

    'If there are unique values start the loop
    If Rcount >= 2 Then
        For Rnum = 2 To Rcount

            'Filter the FilterRange on the FieldNum column
            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value
        
              
              
            'If the unique value is a mail addres create a mail
            If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then

                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                        Range("G1").Value = WorksheetFunction.Max(Range("E2:E34"))
                    On Error GoTo 0
                End With
you would need to add
Code:
Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
 

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
I don't want to change my code in general. Here is what I've got:

Code:
Sub CDO_Mail()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail adress"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With

    strbody = ""


     With iMsg
        Set .Configuration = iConf
        .To = "mail adress"
        .CC = ""
        .BCC = ""
        .From = """Kontrola"" <ep.kontrola@elakov.cz>"
        .Subject = "Headline.:" & Application.WorksheetFunction.Max(Columns("A"))
        .TextBody = strbody
        .Send
    End With
    
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Sub</ep.kontrola@elakov.cz>
I would like to find a way to insert last row into the "strbody". Just like in subject, where the macro automaticly inserts max value in column A.
 

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
Any ideas guys? I would really appreciate any kind of help with this, I'm stuck. :(
 

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
I assume you have to determine the area and then somehow insert it into the body. One way to determine the wanted cells would be (in my case): cells in columns A-N on the row, where the value in column A is highest. But I don't know how to correctly create this condition. :(
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,795
Office Version
2013
Platform
Windows
I think you need to find the last row after it has been added and find the last column and concatenate the data in the row before assigning to the strBody variable.

Code:
Sub GetLastRow()

Dim strBody As String

Set Rng = Worksheets("Sheet1").UsedRange   ' or whatever the range is

LastRow = Rng.Rows.Count
FirstCol = 1                        'A is assumed
LastCol = Rng.Columns.Count


For c = FirstCol To LastCol
For Each cell In Cells(LastRow, c)
strTable = strTable & "  " & cell.Value
Next
Next

strBody = strTable




End Sub
 

Oximoxi

New Member
Joined
May 25, 2018
Messages
22
Hi daverunt,

first of all, thank you very much for your help. I appreciate it! I tried to fit the code you provided in to mine, but the email body is still empty. :/ I'm sure I forgot something important, but don't know what it is. :D

Code:
Sub CDO_Mail()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strBody As String
    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email adress"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With
    

Set Rng = Worksheets("06.18").UsedRange   'or whatever the range is

LastRow = Rng.Rows.Count
FirstCol = 1                        'A is assumed
LastCol = Rng.Columns.Count


For c = FirstCol To LastCol
For Each cell In Cells(LastRow, c)
strTable = strTable & "  " & cell.Value
Next
Next

strBody = strTable


     With iMsg
        Set .Configuration = iConf
        .To = "email adress"
        .CC = ""
        .BCC = ""
        .From = """sender"" <ep.kontrola@elakov.cz>"
        .Subject = "Subject" & Application.WorksheetFunction.Max(Columns("A"))
        .TextBody = strBody
        .Send
    End With
    
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Sub</ep.kontrola@elakov.cz>
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,795
Office Version
2013
Platform
Windows
Hi,

It could be because the sheet is not the active sheet when the mail is created?

Code:
For c = FirstCol To LastCol
For Each cell In Worksheets("06.18").Cells(LastRow, c) <---- change this line to specify the worksheet here.
strTable = strTable & "  " & cell.Value

You can also step through the code in the VB Editor using the F8 key.
As each line of code is passed you can hover over the variables in previous lines to see what is assigned to them.
It may give you a pointer at what/where it is going wrong.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,363
Messages
5,468,184
Members
406,569
Latest member
Quest_

This Week's Hot Topics

Top