This code is the closest I've gotten:
(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
