I am quite new to VBA and I am trying to create a macro that does the following:
1. WorkSheet "Email" contains 3
columns: 1st: Full name; 2nd: email; 3rd: choice (yes or no)
2. There are other worksheets and on each worksheet,
there is a "Send email" button. Whenever people press this button, it will send an email to people on the "Email" with
choice = 'yes'. And this active worksheet will then become the body (in HTML format) of the email.
I got the
following code from this forum:
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
Dim iMsg As Object
Dim iConf As Object
Dim cell As Range
' Dim Flds As Variant
Dim lname As String
Dim Msg As String
Dim Question As String
Application.ScreenUpdating = False
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "LEED"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
lname = ActiveWorkbook.ActiveSheet.name
Msg = "Are you sure you want to send an email?"
Response = MsgBox(Msg, vbYesNo)
If Response = vbYes Then
Question = "***** Please specify what you have changed *****"
Answer = InputBox(Question)
For Each cell In Sheets("EmailList").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set iMsg = CreateObject("CDO.Message")
Set .Configuration = iConf
.To = cell.Value
.From = Environ("USERNAME") & "@abc.ca"
.Subject = "File Updated"
.HTMLBody = "The """ & lname & """ Worksheet has been updated." _
& "Changes: " & Answer _
& "Library Link" _
Set iMsg = Nothing
Set iConf = Nothing
Application.ScreenUpdating = True
Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'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
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
However, sometimes, it doesn't work especially after people using Office 2003 save the file, it will be corrupted. When the
next person opens the file and try to send an email, it complains the Fld and then LCase, and even complaint the "ENVIRON".
The error is "Compile Error - Can't find project or library"
And the weird thing is that even if I just modified
one line, I got the same error.