Escanaba
asked on
Transfering Excel Content To Outlook Email Body
Hello Experts,
I'd like to set up a command buttion which when clicked will transfer all of the text in a range of cells in Excel (A1:I11) and place it in the body of an email in Outlook.
Please advise & thank you!
I'd like to set up a command buttion which when clicked will transfer all of the text in a range of cells in Excel (A1:I11) and place it in the body of an email in Outlook.
Please advise & thank you!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Current Snippet:
Private Sub CommandButton1_Click()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Email Template").Range("A1:I11").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
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Escanaba@whatever.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .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)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
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
ASKER
Ok...Nevermind....
Just realized the .display prompt which takes care of it. Thanks so much for your assistance!!!
Just realized the .display prompt which takes care of it. Thanks so much for your assistance!!!
I was away for a while thats why wasnt able to reply you back and glad you were able to fix it, Also for my reference any particular reason why you graded it B..?
Saurabh...
Saurabh...
ASKER
Saurabh726
Your help was greatly appreciated. I typically give a B grade when responses are links to another Q&A or publication rather than providing the code in the inital response.
Your help was greatly appreciated. I typically give a B grade when responses are links to another Q&A or publication rather than providing the code in the inital response.
Escanaba,
I agree that i gave you link to the page directly but isn't that page covered everything that you need, I can have copied the entire thing and pasted here and thats not the right thing since im not giving the credit to the right person who should ideally get it. Again my only point that i want to make out here, if you follow your rule which you mentioned you should ideally check how much re-work you need to do because of the link provided which was nothing in this case.
Saurabh...
I agree that i gave you link to the page directly but isn't that page covered everything that you need, I can have copied the entire thing and pasted here and thats not the right thing since im not giving the credit to the right person who should ideally get it. Again my only point that i want to make out here, if you follow your rule which you mentioned you should ideally check how much re-work you need to do because of the link provided which was nothing in this case.
Saurabh...
ASKER
We are close but can you tell me what I need to do to prevent this from automatically sending the email out? Ideally I want Outlook to open with the selected range in the body of the email and then have the end user put in their own send to, CC, BC and subject line information and then manually send it out.