How do you copy an excel range (of a file already attached to the email) to the body of the e-mail:
Thanks =]
- As HTML?
- As a Microsoft Office Excel Worksheet Object
- As a bitmap?
How do you copy an excel range (of a file already attached to the email) to the body of the e-mail:
Thanks =]
- As HTML?
- As a Microsoft Office Excel Worksheet Object
- As a bitmap?
I use Excel / Outlook 2007.
See if this is what you are looking for:
http://www.rondebruin.nl/sendmail.htm
It helps a bit. How can I paste an Excel Range (not a chart) in the email body as a bitmap?Originally Posted by JKwan
Last edited by NYCAnalyst; 10-10-2008 at 08:36 AM.
I use Excel / Outlook 2007.
This code is the closest I've gotten:[/VBA]
(From here: http://www.ozgrid.com/forum/showthread.php?t=31388)
However, the code returns in the eMail body:
"This page uses frames, but your browser doesn't support them."
Does anyone know why this is happening and how to fix?
Thanks.
[VBA]
Sub Email_HoldOvers()
Dim SB
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sSubject, sTo As String
Dim ExcelApp As Excel.Application
Dim ExcelXls As Excel.Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
SB = ThisWorkbook.Sheets("Sheet1").Range("C2")
sTo = "" ' put the address's in here I left it blank so you can test it
sSubject = SB
Application.CutCopyMode = False
ThisWorkbook.Sheets("Sheet1").Activate
ThisWorkbook.Sheets("Sheet1").Range("A1:G16").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ExcelApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set ExcelXls = ExcelApp.Workbooks.Add
ExcelXls.Activate
ActiveSheet.Paste
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayZeros = False
Application.CutCopyMode = False
With OutMail
.To = sTo
.Subject = sSubject
'.BodyFormat
.HTMLBody = SheetToHTML(ActiveSheet)
.Save
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
ExcelXls.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Public Function SheetToHTML(sh As Worksheet)
Dim TempFile As String
Dim fso As Object
Dim ts As Object
Dim sTemp As String
Randomize
sh.Copy
TempFile = sh.Parent.Path & "TmpHTML" & Int(Rnd() * 10) & ".htm"
ActiveWorkbook.SaveAs TempFile, xlHtml
ActiveWorkbook.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
sTemp = ts.ReadAll
SheetToHTML = ConvertPixToWeb(sTemp, sh) 'this line is new
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function
Public Function ConvertPixToWeb(sHTML As String, sh As Worksheet) As String
Dim Pic As Picture
Dim lGif As Long
Dim lSrcStr As Long
Dim lSrcEnd As Long
Dim sUrl As String
Dim i As Long
For Each Pic In sh.Pictures
i = i + 1
lGif = InStr(1, sHTML, Format(i, "000")) '& ".bmp")
lSrcStr = InStrRev(sHTML, Chr$(34), lGif)
lSrcEnd = lGif + Len(Format(i, "000")) '& ".bmp")
' sUrl = Chr$(34) & sh.Shapes(Pic.Name)
sHTML = Replace(sHTML, Mid(sHTML, lSrcStr, lSrcEnd - lSrcStr + 1), sUrl)
Next Pic
ConvertPixToWeb = sHTML
End Function
I use Excel / Outlook 2007.
Sub Emailrange()
ActiveSheet.Range("A1:B5").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = "This is a test."
.Item.To = ABD@xxx.com
.Item.Subject = "subject"
.Item.Send
End With
End Sub
I hopt this helps......
Thanks,
Natty
God Bless you , gloring! You saved me so much time. Even the post is almost 10 years old....
Personally I would do it like this
Option Explicit Sub SendWorkBook() 'Graham Mayor - http://www.gmayor.com - Last updated - 26 Nov 2017 'This macro requires the code from 'http://www.rondebruin.nl/win/s1/outlook/openclose.htm 'to open Outlook Dim oOutlookApp As Object Dim oItem As Object Dim olInsp As Object Dim wdDoc As Object Dim oRng As Object Dim xlRng As Range Set xlRng = Range("$I$22:$M$36") 'The range to be copied xlRng.Copy 'Copy it Set oOutlookApp = OutlookApp() 'Use the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm 'to open Outlook, or it will not work correctly 'Create a new mailitem Set oItem = oOutlookApp.createitem(0) With oItem .BodyFormat = 2 'html Set olInsp = .GetInspector Set wdDoc = olInsp.WordEditor 'access the message body for editing Set oRng = wdDoc.Range oRng.collapse 1 'set a range to the start of the message oRng.Text = "This is the message body before the Excel range:" & vbCr & vbCr 'Collapse the range to its end oRng.collapse 0 oRng.Text = vbCr & "This is the text after the Excel range." 'The range will be followed by the signature associated with the mail account 'collapse the range to its start oRng.collapse 1 'paste the excel range in the message oRng.Paste 'Address the message .To = "someone@somewhere.com" 'Give it a title .Subject = "This is the subject" 'attach the workbook .attachments.Add ActiveWorkbook.FullName 'display the message - this line is required even if you then add the command to send the message .display End With 'Clean up Set oItem = Nothing Set oOutlookApp = Nothing Set olInsp = Nothing Set wdDoc = Nothing Set xlRng = Nothing lbl_Exit: Exit Sub End Sub
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com