Have a gmail vba is it possible to add a range of cells into text body?

T

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
3,210
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,

I have this Vba that send an email via gmail works great,

however in the text body i'd like to add the data from "Sheet Data1 range B5:J15"
but make it look like the excel so include the grid

So the message would look a bit like this

Hi,

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]And
[/TD]
[TD]this
[/TD]
[TD]would
[/TD]
[TD]be
[/TD]
[TD]the
[/TD]
[TD]data
[/TD]
[TD]in
[/TD]
[TD]the
[/TD]
[TD]range
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


can it be done and if so how?

please help

thanks

Tony

Code: 
Sub send_email_via_gmail11()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me@gmail.com"
myMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password1"
myMail.Configuration.Fields.Update
With myMail
.Subject = "Untimate Test2"
.From = "me@gmail.com"
.To = "you@gmail.com"
'.CC=
'.bcc=
.TextBody = "Hi"
End With
On Error Resume Next
myMail.Send
MsgBox ("Mail has been send")
Set myMail = Nothing
End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
That's all about outlook i'm trying to use gmail?

any help would be appreciated

Tony
 
Upvote 0
.
Untested BUT Ron is the "go to source" for everything email ...


Code: 
Option Explicit




'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code


'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"


'Use your own mail address to test the code in this line
'.To = "Mail address receiver"


'Change YourName to the From name you want to use
'.From = """YourName"" (Reply@something.nl)"


'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465


'Possible that you must also enable the "Less Secure" option for GMail
'https://www.google.com/settings/security/lesssecureapps


Sub CDO_Mail_Small_Text_3()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    
    Dim r As Range          ''**************************************************
    Set r = Worksheets("Sheet1").Range("F1:F59").SpecialCells(xlCellTypeVisible)  '**************************************
    
    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


    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 = "Mail address receiver"
        .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"
        
        .HTMLBody = RangetoHTML(r) '****************************************************************************
        
        '.Addattachment "c:\temp\Scripty.zip"    ' --- edit path to file
        .Send
        
    End With
    
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Sub
'*************************************************************
'INCLUDE THE ENTIRE FUNCTION BELOW THE EMAIL MACRO THAT IS ABOVE
'*************************************************************
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


'INCLUDE THE FUNCTION ABOVE
'*******************************************************************************

Note the workbook download with samples, about middle of the page : https://www.rondebruin.nl/win/s1/cdo.htm
 
Upvote 0
Ya, you need Ron's - RangeToHTML function, and then change Textbody to HTMLBody.

Code: 
[COLOR=#0000ff].HTMLBody = RangetoHTML(Sheets("Data1").Range("B5:J15"))[/COLOR]
 
Last edited:
Upvote 0
Thanks everyone,
Adding the RangetoHTML function then sett the .HTML body and it works like a dream, thank for all your help

Tony
 
Upvote 0
Glad you have the answer.

Cheers !
 
Upvote 0
Re: Create Gmail Draft?

Hello: thank you for the solutions so far; I am now automating the creation of gmail emails, adding spreadsheet ranges to the email body and sending PDF attachments within excel using vba, however the one thing I cannot figure out, is how to create an email draft only, so that I can review and make changes necessary before sending the email. I've figured out how to do this with Outlook, but not with Gmail...

Any help would be greatly appreciated!

Gagey.
 
Upvote 0
Re: Create Gmail Draft?

Hi,

you should start a new thread for this. It's a new post and I may be proved wrong but I cannot see how it is possible.

You are using the SMTP service on your PC which is a mail transport protocol to send your mail to Gmail servers.
There is no application to 'see the mail' you merely send the information in the correct format.

Sending via Outlook allows you that flexibility to view generated mails etc.
 
Upvote 0
Re: Create Gmail Draft?

Hi: I realized yesterday that I probably need to post this as a new thread (which I later did). Thank you so much for your reply; good to know that this can be done with Outlook but not Gmail.

Have a great day!

Gagey.
 
Upvote 0
You must log in or register to reply here.

Similar threads

pcc
  • Question Question
Sending email prblem
Replies
2
Views
239
pcc
pcc
L
  • Question Question
CDO_Mail_Small_Text Run time error
Replies
0
Views
154
Louis chiron
L
countryfan_nt
  • Question Question
VBA SMTP Sending Outlook mail has no errors, but nothing being sent.
2
Replies
17
Views
770
countryfan_nt
countryfan_nt
C
  • Question Question
Adding Image to email
Replies
1
Views
224
plettieri
P
S
  • Question Question
VBA to email multiple ranges on a sheet.
Replies
0
Views
524
shophoney
S

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,021
Latest member
pingpong7117

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top