Many ways.
The closest off-the-shelf code for what you want is
http://www.mrexcel.com/tip016.shtml
to filter a table and then send the filtered table to each person on a list of recipients.
There are probably a half-dozen methods for sending e-mails. I recently tried searching for them because none does everything I want. Typically:
1) you can send body text or attach a file, but not both.
2) you must preview the message or you can't preview the message.
Using the Object API for your mail program gives the best control, but the most time in learning.
Methods (search excel help for info):
1) "mailto:" Can use in a macro or even the hyperlink function! (search ms site or web for complete info)
2) VBA: use "mailto:" in combination with shell function (sample below from this board)
3) "Application.Dialogs(xlDialogSendMail).Show" (Search MS help and
http://www.mrexcel.com/tip016.shtml)
4) "ActiveWorkbook.SendMail" (search MS help)
5) Outlook (Need to turn on VBA reference, and don't seem to be able to do this from within VBA, so not a good choice when giving the workbook to others.)
6) Manually, File > send To > Mail or Routing
7) Novell Groupwise (Need group wise e-mail program installed) (search novell developer suppor board for GWXls1 and a message from Bob Good, and "object API")
I thought there was more, but it escapes me at the moment.
Have fun.
Here's a bunch of stuff, mostly from boards, not necessarily all tested, but those that I tried worked. I've inserted some notes on the limitations when I found them. There is probably much repetition in the outlook stuff.
METHOD 1::::::::::::::::;;;
=HYPERLINK("mailto:"&B16&"?cc=brian.west@asml.com&subject=Please investigate the event that occurred at "&C16&" on "&TEXT(D16,"yyyy-mm-dd")&"&body="&E15&"="&E16&"%0D%0A"&F15&"="&F16&"%0D%0A"&G15&"="&G16&"%0D%0A%0D%0A"&"Thanks,"&"%0D%0A"&"Brian")
This e-mails info from certain cells on the spreadsheet in B15 to G16:
blank Site Date A B C
westbd@magma.ca San Jose 4/18/2002 1 2 3
METHOD 2.1 :::::::::::::::::::::::::::::::
http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/predefined/mailto.asp
Method 2.2:::::::::::::::::
'From Mr.Excel board
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendMail()
' Creates message including body text but now no excel file attached.
Dim Rng As Range, Cell As Range
Dim URL As String, Email As String
Set Rng = Range(Range("A1"), Range("a1").End(xlDown))
For Each Cell In Rng
Email = Cell.Value
URL = "mailto:" & Email & "?subject=" & "Insert Subject" & "&body=" & "Insert Body"
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
' Note The Shell function runs other programs asynchronously.
' This means that a program started with Shell might not finish executing before the statements following the Shell function are executed.
' Need to play with times to get it to work.
'Application.Wait (Now + TimeValue("0:00:09"))
'Application.SendKeys "%s"
'Application.Wait (Now + TimeValue("0:00:09"))
'MsgBox "Email Sent"
Next
End Sub
METHOD 3.1:::::::::::::::::::::::::::::::::
Mailee = InputBox("Please Enter Name to Send sheet to.........")
subj = InputBox("Please enter eMail Subject..............")
Application.Dialogs(xlDialogSendMail).Show arg1:="", arg2:="As Requested"
Recipients = Mailee.Subject = subj.Close
End Sub
METHOD 3.2::::::::::::::
Public Sub SendItAll()
'2002-04-24 Created by Brian West
'Majority of Macro from Mr.Excel:
http://www.mrexcel.com/tip016.shtml
Dim CountErrors As Integer '2002-04-24: Added by B.West
CountErrors = 0 '2002-04-24: Added by B.West
' Clear out any old data on Report
Sheets("Report").Select
Range("A1").CurrentRegion.ClearContents
' Sort data by region
Sheets("Data").Select
Range("A1").CurrentRegion.Select
Selection.Sort Key1:=Range("A2"), Header:=xlYes
' Process each record on Distribution
Sheets("Distribution").Select
FinalRow = Range("A15000").End(xlUp).Row
For i = 2 To FinalRow
Sheets("Distribution").Select
RegionToGet = Range("A" & i).Value
Recipient = Range("B" & i).Value
' Clear out any old data on Report
Sheets("Report").Select
Range("A1").CurrentRegion.ClearContents
' Get records from Data
Sheets("Data").Select
Range("A1").CurrentRegion.Select
' Turn on AutoFilter, if it is not on
If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
' Filter the data to just this region
Selection.AutoFilter Field:=1, Criteria1:=RegionToGet
' Select only the visible cells and copy to Report
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy Destination:=Sheets("Report").Range("A1")
' Turn off the Autofilter
Selection.AutoFilter
' Copy the Report sheet to a new book
Sheets("Report").Copy
' Name the workbook - 2002-04-24:Added by Brian West
' Note: With Application.FileSearch did not work to detect if the directory exists
On Error GoTo ErrorHandlerCreateDirectory 'If an error, then assume that the d:/temp directory must be created
NewWorkBookName = "D:temp" & Format(Date, "yyyy-mm-dd-") & RegionToGet
ActiveWorkbook.SaveAs (NewWorkBookName)
On Error GoTo 0 'Disable error handler
' Send e-mail with custom subject and the file
Application.Dialogs(xlDialogSendMail).Show _
arg1:=Recipient, _
arg2:="Report for " & RegionToGet & " for " & Format(Date, "yyyy-mm-dd") & "."
'Now how to delete the file? <--- IMPROVE
'Close the file
ActiveWorkbook.Close savechanges:=False
'SEND - does not run since focus is still on the message!
Application.SendKeys "%s"
Application.Wait (Now + TimeValue("0:00:02"))
Next i
Exit Sub ' Exit to avoid handler.
ErrorHandlerCreateDirectory:
CountErrors = CountErrors + 1
If CountErrors = 1 Then 'Assume the cause of the error was the missing directory
MkDir "D:temp"
Resume ' Resume execution at same line that caused the error.
Else 'Must be a different cause for the error - skip saving the file
Resume Next ' Resume execution at line AFTER the one that caused the error.
End If
End Sub
METHOD 4::::::::::::::::::::::::::;;;
Sub SimpleSend()
Sheets("sheet1").Copy
ActiveWorkbook.SendMail Recipients:="email_address@hotmail.com", Subject:="Testing"
'Still no body text!
'BUT THIS ONE SENDS WITHOUT REVIEWING THE MESSAGE (Can be good or bad)
End Sub
METHOD 5.1 ::::::::::::::::::::::::::::::;;
Sub SendEmail()
'Mr Excel board
Dim aOutlook As Outlook.Application, aEmail As Outlook.MailItem
On Error Resume Next
Set aOutlook = GetObject(, "Outlook.Application")
If aOutlook Is Nothing Then Set aOutlook = New Outlook.Application
On Error GoTo 0
If aOutlook Is Nothing Then
MsgBox "Microsoft Outlook is not installed."
Else
Set aEmail = aOutlook.CreateItem(olmailitem)
aEmail.Subject = "Latest figures"
aEmail.Body = "The figures do not include the last two days of trading."
aEmail.Attachments.Add ThisWorkbook.Path & "\data01.xls"
aEmail.Recipients.Add "email@address.com"
On Error GoTo lNoSend
aEmail.Send
MsgBox "Email successfully sent."
End If
Exit Sub
lNoSend:
MsgBox "Email not sent."
End Sub
or
Sub SendEmailNR()
Dim aOutlook As Object, aEmail As Object
On Error Resume Next
Set aOutlook = GetObject(, "Outlook.Application")
On Error GoTo lNoOutlook
If aOutlook Is Nothing Then Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(olmailitem)
On Error GoTo 0
aEmail.Subject = "Latest figures"
aEmail.Body = "The figures do not include the last two days of trading."
aEmail.Attachments.Add ThisWorkbook.Path & "\data01.xls"
On Error GoTo lNoSend
aEmail.Recipients.Add "bigman@hotmail.com"
aEmail.Send
MsgBox "Email successfully sent."
Exit Sub
lNoSend:
MsgBox "Email not sent."
Exit Sub
lNoOutlook:
MsgBox "Microsoft Outlook is not installed."
End Sub
METHOD 5.2 ::::::::::::::::::::::::::
'Control Outlook from Excel
'The two example macros below demonstrates how you can send information to Outlook (e.g. sending an e-mail message) and how you can retrieve information from Outlook (e.g. retrieving a list av all messages in the Inbox).
' requires a reference to the Microsoft Outlook 8.0 Object Library
' Alt-F11>Tools>References>Microsoft Outlook 98 Object Library
Sub SendAnEmailWithOutlook()
'2002-04-26: Created by Brian West WORKS! Sends e-mail without user interaction.
'From
http://www.erlandsendata.no/
' creates and sends a new e-mail message with Outlook
Dim OLF As Outlook.MAPIFolder, olmailitem As Outlook.MailItem, ToContact As Recipient
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olmailitem = OLF.Items.Add ' creates a new e-mail message
With olmailitem
.Subject = "Subject for the new e-mail message" ' message subject
Set ToContact = .Recipients.Add("name@domain.com") ' add a recipient
Set ToContact = .Recipients.Add("name@company.com") ' add a recipient
ToContact.Type = olCC ' set latest recipient as CC
Set ToContact = .Recipients.Add("name@org.net") ' add a recipient
ToContact.Type = olBCC ' set latest recipient as BCC
.Body = "This is the message text" & Chr(13) ' the message text with a line break
.Attachments.Add "D:temp2002-04-25-Central.xls", olByValue, , "Attachment" ' insert attachment
' .Attachments.Add "C:FolderNameFilename.txt", olByReference, , "Shortcut to Attachment" ' insert shortcut
' .Attachments.Add "C:FolderNameFilename.txt", olEmbeddedItem, , "Embedded Attachment" ' embedded attachment
' .Attachments.Add "C:FolderNameFilename.txt", olOLE, , "OLE Attachment" ' OLE attachment
.OriginatorDeliveryReportRequested = True ' delivery confirmation
.ReadReceiptRequested = True ' read confirmation
'.Save ' saves the message for later editing
.Send ' sends the e-mail message (puts it in the Outbox if you are working off-line)
End With
Set ToContact = Nothing
Set olmailitem = Nothing
Set OLF = Nothing
End Sub
METHOD 5.3 ::::::::::::::::
'Add Microsoft Outlook Object Library by selecting VBA_Tools_References then use this code:
'This sub set the range
Sub CallSub()
Dim newRange As Range
Set newRange = Sheet1.Range("B4:D7")
Call CreateNewEmail(newRange)
End Sub
'This sub creates a new email message and fill the subject and also body as your range data
Sub CreateNewEmail(myRange As Range)
Set myOLApp = New Outlook.Application
Dim myOLItem As Outlook.MailItem
Set myOLItem = myOLApp.CreateItem(olmailitem)
With myOLItem
.Subject = "Here is subject"
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
tmptext = tmptext & " " & myRange.Cells(i, j).Value
Next j
tmptext = tmptext & vbCrLf
Next i
.Body = tmptext
End With
myOLItem.Display
End Sub
METHOD 5.4 ::::::::::
'Application.SendKeys "%s"
'Application.Wait (Now + TimeValue("0:00:02"))
'Add Microsoft Outlook Object Library by selecting VBA_Tools_References then use this code:
'This sub set the range
'2002-04-26: Created by Brian West
'From MrExcel msg board
Sub CallSub()
Dim newRange As Range
'Set newRange = Sheet1.Range("B4:D7")
Set newRange = ActiveCell.CurrentRegion
Call CreateNewEmail(newRange)
End Sub
'This sub creates a new email message and fill the subject and also body as your range data
Sub CreateNewEmail(myRange As Range)
Set myOLApp = New Outlook.Application
Dim myOLItem As Outlook.MailItem
Set myOLItem = myOLApp.CreateItem(olmailitem)
With myOLItem
.Subject = "Here is subject"
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
tmptext = tmptext & " " & myRange.Cells(i, j).Value
Next j
tmptext = tmptext & vbCrLf
Next i
.Body = tmptext
End With
myOLItem.Display
End Sub
Sub sendemail10()
'From MrExcel board
'i 'm using the following code in the middle of a procedure to email a file to another user:
Dim OL As Object
Dim MailSendItem As Object
Dim olmailitem As String
Set OL = CreateObject("Outlook.Application")
Set MailSendItem = OL.CreateItem(0)
With MailSendItem
.Subject = "Email"
.Body = strBody
.To = strEmail
.Attachments.Add ("C:\File.xls")
.Send
End With
'I state in the user guide that the user must have MS Exchange as it seems to work on my work and home PC (both with MS Exchange). The problem is some users with MS Exchange don't have the email send automatically. Any suggestions???
End Sub
METHOD 5.5 :::::::::::::;;
Sub Send_Msg()
' 2002-04-26: Created by Brian West
' From
http://www.mindspring.com/~tflynn/excelvba2.html
'
http://www.mindspring.com/~tflynn/excelvba.html#bMail
' You should create a reference to the Outlook Object Library in the VBEditor
' VBE help: "Check or Add an Object Library Reference"
' Tools > References > Microsoft Outlook 98 Object Library
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
With objMail
.To = "brian.west@asml.com;
westbd@magma.ca"
.Subject = "Automated Mail Response"
.Body = "This is an automated message from Excel. " & _
"The cost of the item that you inquired about is: " & _
Format(Range("A1").Value, "$ #,###.#0") & "."
.Display
End With
Set objMail = Nothing
Set objOL = Nothing
End Sub
METHOD 7.1 :::::::::::::::::;
http://developer.novell.com/ndk/doc/gwobjapi/index.html?gwobjenu/data/h7ikbsqg.html
METHOD 7.2 :::::::::::::::::;
http://developer.novell.com/support/sample/tids/gwxls1/gwxls1.htm
METHOD 7.3 :::::::::::::::::;
' Groupwise Send simple message in VBA
' by Bob Good - An independent programmer from Oconomowoc, WI USA
' contact info - mailto:bob@bobgood.com
' phone +1 262 560 1664
' provided free and without warranty
' please include this disclaimer if copying.
'
' This is a simple example of logging into Groupwise
' sending a mail message to a single recipient
' with an attachment
' and logging out
'
' known limitations - If Groupwise is running (and Groupwise is
' running if another program has a reference to it, such as
' Notify or a custom application), then the account that sends
' the message will be the currently logged in account, rather
' than the account passed in the arguments.
' Error handling for unresolved recipients was removed for
' simplicity.
'
'**********************************************************************
Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.Account
Sub GroupWiseSendMail(strLoginName, _
strMailPassword, _
strTo, _
strCC, _
strBCC, _
strSubject, _
strBody, _
strAttachFullPathName)
Dim sCommandOptions as String
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Const NGW$ = "NGW"
' >>> set application object reference if needed
If ogwApp Is Nothing Then ' Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If
If ogwRootAcct Is Nothing Then ' Need to log in
'>>> login to root account
If Len(strMailPassword) then ' Password was passed - use it
sCommandOptions = "/pwd=" & strMailPassword
Else ' Password was not passed
sCommandOptions = vbNullString
End If
Set ogwRootAcct = ogwApp.Login(strLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents
End If
' <<<<<<<<<< Create new message >>>>>>>>>>
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents
' <<<<<<<<<< Start adding recipients >>>>>>>>>>
With ogwNewMessage
With .Recipients
.Add strTo, NGW, egwTo
.Add strCC, NGW, egwCC
.Add strBCC, NGW, egwBCC
End With
' <<<<<<<<<< Get the SUBJECT text >>>>>>>>>>
.Subject = strSubject
' <<<<<<<<<< Build the BODY text >>>>>>>>>>
.BodyText = strBody
' <<<<<<<<<< Create Attachment >>>>>>>>>>
.Attachments.Add strAttachFullPathName, egwFile
' <<<<<<<<<< Send the Mail >>>>>>>>>>
On error Resume Next
' Send method may fail if recipients don't resolve
.Send
DoEvents
On Error Goto 0
End With
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
End Sub
--
Regards,
Bob Good
Novell SysOp 6
Helping from Wisconsin, USA
http://www.execpc.com/~bobgood/
OTHER::::::::::;;
Sub DisplayMailer()
'This example displays the name of the mail system that's installed on the computer.
'xx = Application.MailSystem
'MsgBox (xx)
Select Case xx
Case xlMAPI
MsgBox "Mail system is Microsoft Mail"
Case xlPowerTalk
MsgBox "Mail system is PowerTalk"
Case xlNoMailSystem
MsgBox "No mail system installed"
End Select
End Sub