Can I send a doc to group of email addresses via a macro button?

G

Guest

I have set up an Excel report into which staff enter data.

Is it possible to set up a macro which staff can 'click' once, resulting in
the report being emailed, as an attchment, to a number of email addresses?

I can use a hyperlink to open Outlook, but there is no report attached. I
can also create a macro to activate the 'Send to' comand, but staff then have
to select a group email. I can't seem to combine both with just one click.

I am using Excel 2003 and Outlook 2003.
 
R

Ron de Bruin

hi Richard

Yes this is possible

How many addresses ?
Do you use Outlook ?
Are the addresses in a group in Outlook
Or do you have them in range in your workbook
 
G

Guest

Hi Galimi

I am aware how to link to Outlookl via a hyperlink, but I need to know if I
can attach the actual document as well on the same click.

Regards
Richard
 
G

Guest

Hi Ron

1) 4 email addresses (this number is subject to change, but will not exceed
more than a handfull.

2) I Use Outlook & Excel - both 2003

3) The email addresses are in a range in the document.

If necessary, I could add a group address to the company Global Address
Book. Some of the names are not listed as single entries as they do not work
for my company.

Regards
Richard
 
R

Ron de Bruin

OK

For the whole workbook use this macro
http://www.rondebruin.nl/mail/folder2/mail1.htm

And when you click on the Tip link on the page
http://www.rondebruin.nl/mail/tips2.htm
You see the code you want

Try this example and change the sheet/ range to the sheet/range where your E-mail addresses are

For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("A1:A10").Cells.SpecialCells(xlCellTypeConstants)



Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strto As String

On Error Resume Next
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("A1:A10").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
On Error GoTo 0
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = strto
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top