I stumbled across Ron Debruin's site Sending mail from Excel with CDO and was able to get an email to send in gmail finally (had to change port to 465 and then change my gmail settings) but he also had a couple of other things to try - - - Download Example workbook http://www.rondebruin.nl/win/winfiles/CDO_Example_Code.zip with all the code and trying to consolidate: gmail & add a range (body 1) & work from a list (body 2)
On my Sheet1 - - - I'm trying to add a range (F1:F59) as the body of the email and work from a distribution list (Col B holds email and Col C is all "yes")
I am not a vba expert by any means - - - but I think I'm having problems because of 2 Ranges and not sure why I'm not able to add text body from a range F1:F59 it seems to hang on the
.HTMLBody = RangetoHTML(rng) line
I am also trying to add the list code (not caring about Column A names which Ron has) - - - so it will send out one email at a time to each until list is exhausted (in the .TO)
I'm also unsure about the .From = """YourName"" Reply@something.nl" line and assuming that all that is needed here is drop in my name along with my email address - - - the Reply@something.nl actually has less than greater than around it but it isn't showing up
Would someone mind taking a look at this and help me out?
THANKS IN ADVANCE
On my Sheet1 - - - I'm trying to add a range (F1:F59) as the body of the email and work from a distribution list (Col B holds email and Col C is all "yes")
I am not a vba expert by any means - - - but I think I'm having problems because of 2 Ranges and not sure why I'm not able to add text body from a range F1:F59 it seems to hang on the
.HTMLBody = RangetoHTML(rng) line
I am also trying to add the list code (not caring about Column A names which Ron has) - - - so it will send out one email at a time to each until list is exhausted (in the .TO)
I'm also unsure about the .From = """YourName"" Reply@something.nl" line and assuming that all that is needed here is drop in my name along with my email address - - - the Reply@something.nl actually has less than greater than around it but it isn't showing up
Would someone mind taking a look at this and help me out?
Code:
Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim rng As Range
Dim cell As Range
' With Application
' .ScreenUpdating = False
' .EnableEvents = False
' End With
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/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
Set rng = Sheets("Sheet1").Range("F1:F59").SpecialCells(xlCellTypeVisible)
' Set rng = ActiveSheet.UsedRange
' Set rng = Sheets("Sheet1").UsedRange
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
' strbody = "Hi there" & vbNewLine & vbNewLine & _
' "This is line 1" & vbNewLine & _
' "This is line 2" & vbNewLine & _
' "This is line 3" & vbNewLine & _
' "This is line 4"
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set iMsg = CreateObject("CDO.Message")
With iMsg
Set .Configuration = iConf
' .To = "Mail address receiver"
.To = cell.Value
.CC = ""
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """YourName"" <Reply@something.nl>"
.Subject = "Important message"
' .TextBody = strbody
.HTMLBody = RangetoHTML(rng)
.Send
End With
Set iMsg = Nothing
End If
End If
Next cell
' With Application
' .EnableEvents = False
' .ScreenUpdating = False
' End With
End Sub
THANKS IN ADVANCE
Last edited: