This page lists several ways to send Outlook messages from Excel. You may also want to visit Send worksheets by email as separate workbooks for more sample code.
UDF to Send Email From Excel Using Outlook
Here is a VBA macro that is actually a UDF (User Defined Function) to send messages (using Outlook) directly from the Excel worksheet.
Public Enum ImportanceLevel
High
Medium
Low
End Enum
Function SendMessage(Msg As String, Subject As String, EmailTo As String, _
Optional EmailCC As String, Optional EmailBCC As String, _
Optional Attachment As String, _
Optional Importance As ImportanceLevel = 1)
' fill out Outlook email message using function parameters
' by Jimmy Pena, http://www.jpsoftwaretech.com, October 18 2009
On Error Resume Next
Const olMailItem As Long = 0
Dim Outlook As Object ' Outlook.Application
Dim OutlookMsg As Object 'Outlook.MailItem
' create Outlook session
Set Outlook = GetOutlookApp
If Outlook Is Nothing Then GoTo ProgramExit
' create msg
Set OutlookMsg = Outlook.CreateItem(olMailItem)
With OutlookMsg
' set basic params
.Subject = Subject
.HTMLBody = Msg
.To = EmailTo
' add cc's (if any)
If Len(EmailCC) > 0 Then
.CC = EmailCC
End If
' add bcc's (if any)
If Len(EmailBCC) > 0 Then
.BCC = EmailBCC
End If
' add attachments
If Len(Attachment) > 0 Then
If Len(Dir(Attachment)) > 0 Then
.Attachments.Add (Attachment)
End If
End If
' set importance
Select Case Importance
Case 0 ' high
.Importance = olImportanceHigh
Case 1 ' medium
.Importance = olImportanceNormal
Case 2 ' low
.Importance = olImportanceLow
End Select
.Display
End With
ProgramExit:
Exit Function
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
End FunctionTo use, paste the above code into a standard VBA module, then use in the worksheet like this:
=SendMessage(A1,A2,A3,A4,A5,A6,A7)
If you put the code in your PERSONAL.XLS file (or in any workbook other than the one where the function is being used), you may have to qualify the function like this:
=PERSONAL.XLS!SendMessage(A1,A2,A3,A4,A5,A6,A7)
Where A1 contains a text string you want to send as the Body, A2 contains a text string with the email subject, A3 contains an email address or comma-separated list of email addresses (or a name resolvable in Outlook), A4 contains the (optional) email CC, A5 contains the (optional) email BCC, A6 contains the (optional) full path and filename of an attachment you want to send, and A7 is a number from 0 to 2 indicating the importance level (0 for High, 1 for Normal/Medium, or 2 for Low).
Mail Worksheet Using Outlook
This function uses the GetOutlookApp function shown above to mail a copy of a worksheet to a recipient using the Outlook object model. Using this code you can easily mail each worksheet in a workbook to individual email addresses, or just mail an individual worksheet.
Function MailSheet(wksht As Excel.Worksheet, recipAddress As String, _
bodyEmail As String, subject As String)
' mails a copy of whatever worksheet is passed to it
' to whatever recipient is specified
On Error GoTo ErrorHandler
Const olMailItem As Long = 0
Dim olApp As Object ' Outlook.Application
Dim Msg As Object ' Outlook.MailItem
Dim wkbkName As String
' get a copy of Outlook
Set olApp = GetOutlookApp
If olApp Is Nothing Then GoTo ProgramExit
' create new workbook from sheet, save in temp folder
wkbkName = SaveWorksheet(wksht, Environ("temp") & Application.PathSeparator)
Set Msg = olApp.CreateItem(olMailItem)
With Msg
.To = recipAddress
.Body = bodyEmail
.Subject = subject
.Attachments.Add wkbkName
' to avoid the security prompt, display only
.Display
End With
'kill temp workbook
Kill wkbkName
ProgramExit:
Exit Function
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Function
Function SaveWorksheet(sht As Excel.Worksheet, folder As String) As String
' saves worksheet as workbook in specified folder (using sheet name) and
' returns string filepath; assumes unique sheet name
Dim wkbk As Excel.Workbook
Dim wksht As Excel.Worksheet
Dim newWkbkSheets As Long
newWkbkSheets = Application.SheetsInNewWorkbook
With Application
.SheetsInNewWorkbook = 1
.ScreenUpdating = False
End With
Set wkbk = Excel.Workbooks.Add
Set wksht = wkbk.Worksheets(1)
sht.Copy Before:=wkbk.Sheets(wksht.Index)
Application.DisplayAlerts = False
wksht.Delete
Application.DisplayAlerts = True
wkbk.SaveAs fileName:=folder & sht.Name, FileFormat:=xlNormal
SaveWorksheet = wkbk.FullName
wkbk.Close True
With Application
.SheetsInNewWorkbook = newWkbkSheets
.ScreenUpdating = True
End With
End FunctionMail Workbook Using Outlook
Mailing an entire workbook can be accomplished using the following sample VBA code. Note that this procedure also uses the GetOutlookApp function from above.
Function MailWorkbook(wb As Excel.Workbook, recipAddress As String, _
bodyEmail As String, subject As String)
' mails a copy of whatever workbook is passed to it
' to whatever recipient is specified
On Error GoTo ErrorHandler
Const olMailItem As Long = 0
Dim olApp As Object ' Outlook.Application
Dim Msg As Object ' Outlook.MailItem
' get a copy of Outlook
Set olApp = GetOutlookApp
If olApp Is Nothing Then GoTo ProgramExit
Set Msg = olApp.CreateItem(olMailItem)
With Msg
.To = recipAddress
.Body = bodyEmail
.Subject = subject
.Attachments.Add wb.FullName
' to avoid the security prompt, display only
.Display
End With
ProgramExit:
Exit Function
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End FunctionEmbed Picture in Email
In Export Excel Range to a Picture File I posted a technique for exporting an Excel range to a picture file for, mostly for use in other applications.
Alex J. sends me a code sample that embeds the image in the body of an email so it is immediately viewable by the recipient (i.e. not an attachment).
.HTMLBody = "<body><font face=Arial color=#000080 size=2></font>" & _
"<img alt='' hspace=0 src='cid:EmailTemp.gif' align=baseline 0rder=0> " & _
"<br /><br />Plus add any text you want</body>"
