identify a range of data to send in an email

[tbrynard01]

This is the start of the code:
Sub Button1_Click()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String


strSubject = "MHR Request"
strFrom = "tbrynard@harmonyfoundationinc.com"
strTo = "tbrynard@harmonyfoundationinc.com"
strCc = ""
strBcc = ""
strBody = ???

I'm stuck on how to display a range of data from the sheet in the body of the email??

Thanks

 

[Kenneth Hobson]

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

 

[tbrynard01]

I looked at that document but am not sure what needs to go there. I apologize don't really know VBA that well and found that code. The rest works well, only challenge is to copy the range of cells from the worksheet into the email.

Thank you

 

[Kenneth Hobson]

If you don't know what your range or other data for the email is, I sure don't.

Snippet example
Ron's code:

.To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)

Modified examples:

        .To = Range("A2")
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line: " &  Range("B2")
        '.HTMLBody = "Hello World! & vbcrlf & RangetoHTML(ActiveSheet.UsedRange)
        .HTMLBody = "Hello World! & vbcrlf & RangetoHTML(Range("A1:E21"))

 

[tbrynard01]

I apologize if I seem ignorant, this is the code that I found that is working until I get to the body of the email
Sub Button1_Click()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String


strSubject = "MHR Request"
strFrom = "tbrynard@harmonyfoundationinc.com"
strTo = "tbrynard@harmonyfoundationinc.com"
strCc = ""
strBcc = ""

your example is using .htmlbody and I'm not sure where to put that

the sheet that contains my data is Sheet1 (which I named Form) and the data range is A1:D19, again am a novice and not sure where to add what in the code above.

I appreciate your help and patience!

 

[Kenneth Hobson]

Please paste code between code tags. Click the # icon on reply bar to insert the tags.

Your code is partial and does not assign the values to the OutLook or CDO fields. You don't really need those variables. Just do the work in the Outlook field values. Some use a variable for the .Body or .htmlBody since it may have lots of string concatenation but that can be done in the field too. You don't need to assign "" to fields. Just set the values for the fields needed. This is based on Ron's partial code and yours. Obviously, you need to add his RangeToHTML() routine.

'snip...

strSubject = "MHR Request"
strFrom = "tbrynard@harmonyfoundationinc.com"
strTo = "tbrynard@harmonyfoundationinc.com"
strCc = ""
strBcc = ""

'.snip......

'.SentOnBehalfOf = strFrom 'Not needed normally
.To = strTo
.CC = strCC
.BCC =strBCC
.Subject = strSubject
'.HTMLBody = "Hello World! & vbcrlf & RangetoHTML(ActiveSheet.UsedRange)
 .HTMLBody = RangetoHTML(WorkSheets("Form").Range(A1:D19"))
'or
'.HTMLBody = RangetoHTML(WorkSheets(1).Range(A1:D19"))
'or
'.HTMLBody = RangetoHTML(Sheet1.Range(A1:D19")) 'Sheet1 is the sheet's codename, which may not be the tab's name, Form.

'snip......

It looks like you are using CDO rather than the Outlook object? I would have to check to see if it allows a SendOnBehalfOf field. Again, without the full code, I don't really know what all you have going on.

CDO does have .Body and .htmlBody as Outlook does. Outlook also has a WordEditor method to fill the body of the email. With Outlook you can use 1 of 3 body fill methods. CDO, you can use 1 of 2 methods.

 

[tbrynard01]

Here's the full code I'm using the body is the only issue I'm having if I take that out the rest works perfectly. Again thank you!

Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strHTMLBody As String
Dim strRangetoHTML As String


strSubject = "MHR Request"
strFrom = "tbrynard@harmonyfoundationinc.com"
strTo = "tbrynard@harmonyfoundationinc.com"
strCc = ""
strBcc = ""
.HTMLBody = RangetoHTML(Worksheets(1).Range("A1:D19"))


Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling


Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1


Set SMTP_Config = CDO_Config.Fields


With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.outlook.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "tbrynard@harmonyfoundationinc.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxxxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With


With CDO_Mail
Set .Configuration = CDO_Config
End With


CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send


Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description


End Sub

 

[Kenneth Hobson]

.TextBody in CDO is the same as .Body in Outlook. Replace it as I explained with .htmlBody for either CDO or Outlook. The dot, period, ".", is used when people use With SomeObjectName like CDO_Mail.

If still a problem please add the code tags and post back. I will fix it as explained. Code tags keep your structure (indents) so it is easier to read what is going on.

Here is some CDO code that I have used for Gmail.

Sub Test_Gmail()
  Gmail "ken@gmail.com", "ken", "Hello World!", _
    "This is a test using CDO to send Gmail with an attachement.", _
    "khobson@somewhere.org", "uknowwho@nowwhere.com", _
    "x:\test\test.xlsm"
End Sub

' http://www.blueclaw-db.com/access_email_gmail.htm
' http://msdn.microsoft.com/en-us/library/ms872547%28EXCHG.65%29.aspx
' Add CDO reference for early binding method
'  Tools > References > Microsoft CDO for Windows 2000 Library
'    c:\windows\system32\cdosys.dll
' http://www.rondebruin.nl/cdo.htm  'Other cdo tips for cdo to Outlook from Excel

'CDO to gmail requires lowering your security:
'https://myaccount.google.com/security#connectedapps
'at the end set, Allow less secure apps: ON

Function Gmail(sendUsername As String, sendPassword As String, subject As String, _
  textBody As String, sendTo As String, sendFrom As String, _
  Optional sAttachment As String = "")
  
  Dim cdomsg As New CDO.Message  'early binding method
  'set cdomsg=new CDO.Message 'early binding only
  'Dim cdomsg As Object 'late binding method
  Set cdomsg = CreateObject("CDO.message")  'late binding method or early binding
 
  With cdomsg.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25  '25 or 587
    .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") = sendUsername
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPassword
    .Update
  End With
  ' build email parts
  With cdomsg
    .To = sendTo
    .From = sendFrom
    .subject = subject
    .textBody = textBody
    '.BCC
    '.CC
    '.ReplyTo = sendFrom
    '.HTMLBody
    '.HTMLBodyPart
    If Dir(sAttachment) = "" Then sAttachment = ""
    If sAttachment <> "" Then .AddAttachment (sAttachment)
    .Send
  End With
  Set cdomsg = Nothing
End Function

 

[Fire_Chief]

Can you get this code to work with Yahoo mail? I have tried for days and can't.
I want to send cells A5: W28 of my worksheet.

Thank You so much

 

[Kenneth Hobson]

Obviously, my code in #8 would not "work" since it is set for the yahoo server. It does not take much effort to change it for yahoo. I have not tested it but have you tried?

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update