Send to mail recipient

[Bob T]

Is there a way to use a hyperlink or create a macro that sends a sheet to a particular mail recipient? I would like to have each sheet being sent to a different place.

[James]

Hi Bob,

This subject comes up at least once a week
and has been discussed at length do, a search
and i'm almost sure you will find the answer
your looking for

James

[Brian]

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/de...ned/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/.../h7ikbsqg.html
METHOD 7.2 :::::::::::::::::;
http://developer.novell.com/support/...ls1/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

[Tom Schreiner]

That's a REPLY!!!!

[gareth]

That is a hell og a reply Tom