VBA to send rows meeting criteria in a column

[asantos2015]

Hello Folks,

Can you guys have a look at the code below and fix the part where it gets only the rows meeting a criteria "Repor" in column O and throws it in the body of the email?

The code below is sending the entire table (11MB).

THANK YOU!

ub CDO_Mail_Small_Text()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    '    Dim Flds As Variant
    Dim rng As Range
    Dim j As Integer
    Dim Source As Worksheet
    


    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    
    '   Set Source = ActiveWorkbook.Worksheets("All")
    Set rng = Sheets("Ponto de Reposição").Range("A7:O8000").SpecialCells(xlCellTypeVisible)
          
    
    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") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "antonio@ataldacastanha.com.br"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "hope2015"
        .Update    'Let CDO know we have change the default configuration for this message
    End With
    
    For Each rng In Sheets("Ponto de Reposição").Range("a7:o8000")   ' This part is the one messed up.
        If rng = "Repor" Then
           rng.Rows ("C" & c.Row & ":B" & c.Row)
           j = j + 1
        End If
    Next rng
    '   If Sheets("Ponto de Reposição").Range("o10").Value = "Repor" Then
    '   strbody = "Atenção! Esses itens chegaram no estoque mínimo." & " Favor verificar imediatamente e confirmar a necessidade de compra! & ValueofColumn E"
    
    '   strbody = "Atenção! Esses itens chegaram no estoque mínimo." & " Favor verificar imediatamente e confirmar a necessidade de compra!" & vbNewLine & _
        "<br>" & "<br>" & vbNewLine & _
        "This is line 2" & vbNewLine & _
        "This is line 3" & vbNewLine & _
        "This is line 4"


    With iMsg
        Set .Configuration = iConf
        .To = "antonio@ataldacastanha.com.br"
        .CC = "antoniosan0@hotmail.com"
        .BCC = ""
        .From = """Estoque"" <antonio@ataldacastanha.com.br>"
        .Subject = "Atenção! Estoque de Insumos e MP baixo!"
        .HTMLBody = RangetoHTML(rng)
        .Send
    End With


End Sub

 

[RickXL]

Hi,

There appear to be another post in this forum asking the same thing. https://www.mrexcel.com/forum/excel...rows-based-column-value-through-cdo_mail.html

Then there is this one at stackoverflow: https://stackoverflow.com/questions...a-criteria-in-a-column-on-cdo-basis-vba-excel

And this one at nullskull: http://www.nullskull.com/q/10480517...e-in-the-body-of-an-email-cdo-like-gmail.aspx

And this one at MSDN: https://social.msdn.microsoft.com/F...-enviar-a-linha-no-corpo-do-email?forum=vbapt

There are rules for posting here (and in all forums, as far as I know) and you might want to review our rule 13: https://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html

On to the question ...

The code for RangetoHTML was not included so it was not possible to test your code directly. However, I recognised that it most likely was the RangetoHTML function that Ron de Bruin has on his site. (He is my "go to" email expert). It looks as if the other code may have originated there as well.

I looked at the code and decided not to use a loop to select the data. I used an AutoFilter instead. I hope that is OK. That meant that I could use PublishObjects directly without needing to create a temporary workbook.

Your CDO email settings do not work for me so I took a crash course on CDO emails from Ron de Bruin. I restored your settings in the code below. I hope it works.

Sub CDO_Mail()
    Dim TempFile    As String
    Dim strHTML     As String
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    With ThisWorkbook
        With .Worksheets("Ponto de Reposição")
            .UsedRange.AutoFilter Field:=15, Criteria1:="Repor"
            With .Parent.PublishObjects.Add(SourceType:=xlSourceAutoFilter, _
                                     Filename:=TempFile, _
                                     Sheet:=.Name, _
                                     Source:=.UsedRange.Address, _
                                     HtmlType:=xlHtmlStatic)
                .Publish (True)
            End With
            .ShowAllData
            .AutoFilterMode = False
        End With
        
        With CreateObject("Scripting.FileSystemObject").GetFile(TempFile).OpenAsTextStream(1, -2)
            strHTML = .readall
            .Close
        End With
        strHTML = Replace(strHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    End With
 
    Kill TempFile
    
    With CreateObject("CDO.Message")
       With .Configuration
            .Load -1 ' CDO Source Defaults
            With .Fields
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "antonio@ataldacastanha.com.br"
                .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "hope2015"
                .Update 'Let CDO know we have change the default configuration for this message
                .Update
            End With
        End With
        
        .To = "antonio@ataldacastanha.com.br"
        .CC = "antoniosan0@hotmail.com"
        .BCC = ""
        .From = """Estoque"" "
        .Subject = "Atenção! Estoque de Insumos e MP baixo!"
        .HTMLBody = strHTML
        .Send
    End With
End Sub

I also removed many of the variables and substituted With/End With blocks. I think it helps to make the code more understandable. IMHO!

If this solution works you should really inform the other forums where you posted the same question so that no-one expends any time trying to create another solution.


Regards,

 

[Rick Rothstein]

Hi,

There appear to be another post in this forum asking the same thing. https://www.mrexcel.com/forum/excel...rows-based-column-value-through-cdo_mail.html

Then there is this one at stackoverflow: https://stackoverflow.com/questions...a-criteria-in-a-column-on-cdo-basis-vba-excel

And this one at nullskull: http://www.nullskull.com/q/10480517...e-in-the-body-of-an-email-cdo-like-gmail.aspx

And this one at MSDN: https://social.msdn.microsoft.com/F...-enviar-a-linha-no-corpo-do-email?forum=vbapt

There are rules for posting here (and in all forums, as far as I know) and you might want to review our rule 13: https://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html

A message to asantos2015... in light of all the cross posting you have done, please read the (complete) article at this link

https://www.excelguru.ca/content.php?184

 

[RoryA]

Duplicate so closed.