It is possible to use the built-in function ActiveWorkbook.SendMail. However, it only allows simple e-mails to be created, and there is no way to add attachments.
In this example we are going to use the COM library of Microsoft Outlook to get more control. Attachments are not covered in this example.
We start by checking if an instance of Outlook is already running. To be independent of the installed version of Outlook we use the GetObject to try to get an existing instance. Another option would have been to reference the Outlook library directly, but then we are required to update the reference every time a new version of Microsoft Office is installed. If no instance is running, we start Outlook by calling CreateObject. Please remember to close down Outlook when you are finished. Otherwise you will get multiple instance of the same application without the user knowing it.
We get a reference to the current users inbox by calling getDefaultFolder(6).The value 6 is a constant referring to the Inbox. If you used a reference to the COM library, you would have used the enum value olFolderInbox.
' Send E-mail
' strTo - Recipients. List of e-mails (separated by ';')
Public Sub SendEmail(ByVal strTo As String)
Dim objOutlookApp As Object
Dim objEmail As Object
Dim objMapi As Object
Dim objInboxFolder As Object
' Valid e-mails?
If (strTo = "") Then
' Error
MsgBox "No e-mails have been set!", vbExclamation, "No e-mails"
' Finished
Exit Sub
End If
' Attach to outlook
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0
' Is Outlook running?
If (objOutlookApp Is Nothing) Then
' Create new instance of outlook
Set objOutlookApp = CreateObject("Outlook.Application")
' Get the MAPI namespace (e-mails)
Set objMapi = objOutlookApp.GetNamespace("MAPI")
' Get the inbox folder
Set objInboxFolder = objMapi.getDefaultFolder(6)
' Display the inbox folder (make outlook visible)
Call objInboxFolder.Display
End If
' Create the new e-mail
Set objEmail = objOutlookApp.CreateItem(0)
' Set the properties of the new email
With objEmail
' Set the recipients
.To = strTo
' Show the message
Call .Display
' Resolve all recipients (Same as pressing the "Check Names" button)
Call .Recipients.ResolveAll
End With
' Free memory
Set objEmail = Nothing
Set objOutlookApp = Nothing
End Sub
