Prepare a Email Comm Template

sur

Board Regular
Joined
Jul 4, 2011
Messages
176
Hello All,


Please help me in preparing a Email template from excel.


from: should be from Range A1
To ; Should be from Range A2
CC ; Should be from Range A3
Subject; Should be from Range A4


and the body for Email should be from


A7:E20


Thanks and Regards
Suresh H
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Take a look at this great helpful website from Ron Mail from Excel with Outlook (VBA)

You can put in Range("A1").value etc.. for cell A1

This is what I used (xxx redacted info)

Code:
Sub Send_To_Outlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim body As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    If Len(Range("G2").Value) > 0 Then
    
        On Error Resume Next
    With OutMail
        .To = Range("D" & ActiveCell.Row).Value
        .CC = Range("E" & ActiveCell.Row).Value
        '.FROM = Range("D" & ActiveCell.Row).Value
        '.BCC =
        .Subject = Range("F2").Value
        .SentOnBehalfOfName = Range("C2").Value
        '.body = body
        .body = Range("G2").Value
        '.BodyFormat = olFormatRichText
        .BodyFormat = 2  '2 for html '3 For Rich Text
        .Attachments.Add (Range("I" & ActiveCell.Row).Value)
        .Attachments.Add (Range("J" & ActiveCell.Row).Value)
        .Attachments.Add (Range("L" & ActiveCell.Row).Value)
        .Attachments.Add (Range("K" & ActiveCell.Row).Value)
        .Attachments.Add (Range("M" & ActiveCell.Row).Value)




        .Send
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Else
    
        On Error Resume Next
    With OutMail
        .To = Range("D" & ActiveCell.Row).Value
        .CC = Range("E" & ActiveCell.Row).Value
        '.FROM = Range("D" & ActiveCell.Row).Value
        '.BCC = "xxx"
        .Subject = Range("F2").Value
        .SentOnBehalfOfName = Range("C2").Value
       ' .SentOnBehalfOfName = """xxx"" <xxx>"
        '.body = body
        .HTMLBody = Range("H2").Value
        '.BodyFormat = olFormatRichText
        .BodyFormat = 2  '2 for html '3 For Rich Text
        .Attachments.Add (Range("L" & ActiveCell.Row).Value)
        .Attachments.Add (Range("M" & ActiveCell.Row).Value)
        .Attachments.Add (Range("I" & ActiveCell.Row).Value)
        .Attachments.Add (Range("J" & ActiveCell.Row).Value)
        .Attachments.Add (Range("K" & ActiveCell.Row).Value)


        .Send
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
 End If
End Sub
 
Last edited:
Upvote 0
I have the below code where is working,


2) Body of the Email now is (A7:E20).


3) if there is any additional lines in between it should also take into consideration.


4) but i have an additional requirement my body of the email from excel sheet should be untill the in Column A equals to (Thank you and best regards,)
Sub List()

' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Sheets("List").Select
Set rng = Nothing


Set rng = ActiveSheet.Range("A1:C9")
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.from = " "
.To = ""
.CC = ""
.BCC = " "

.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub
Function RangetoHTML(rng As Range)




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
 
Upvote 0

Forum statistics

Threads
1,213,564
Messages
6,114,334
Members
448,567
Latest member
Kuldeep90

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