Here is the code I came up with.
Two problems:
1. When user clicks No to send an email - I get an error
2. I get an error in line "Set ts =
fso.GetFile(TempFile).OpenAsTextStream(1, -2)" on close too
Any help is appreciated.
Thx
=================================================
Private Sub Workbook_Open()
'WriteTwiki
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
WriteTwiki
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Mail_ActiveSheet_Body
End Sub
Sub Mail_ActiveSheet_Body()
Dim OutApp As Object
Dim OutMail As Object
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
.Subject = "Test Systems useage has changed, please review"
.HTMLBody = SheetToHTML(ActiveSheet)
'.Display
.Send 'or use .Display
End With
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'
http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003
Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object
sh.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function
Sub WriteTwiki()
ActiveWorkbook.SaveAs _
Filename:="\\files.mercedsystems.com\qa-public\QA\DOC\instance_usage_new.html",
_
FileFormat:=xlHtml
'ActiveWorkbook.SendMail Recipients:="(e-mail address removed)"
End Sub
===============================================
