mail
 

All,

I found this code example in the tips section of exceltips.com and i
think this is really useful. I was wondering if it could be modified so
that i could enter a list of email address in column b and get the code
to loop through until it reaches the end rather than having to
re-create the code accross many columns to send the same sheets.

Any help you can provide will be much appreciated.






Mail sheet(s) to one or more people using VBA in Microsoft Excel
VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel
CATEGORY: Mail - Send and Receive in VBA

VERSIONS: All Microsoft Excel Versions
Add new sheet, change the sheet name to mail.
Every mail you want to send will use 3 columns.

1. in column A - enter sheet or sheets name you want to send.
2. in column B - enter E-mail address.
3. in column C - the subject title appears at the top of the E-mail
message.

Column A:C enter information for the first mail and you may use columns
D:F for the second one.
you can send 85 different E-mails this way (85*3 = 255 columns).

Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then Exit
Sub
Application.ScreenUpdating = False
last = ThisWorkbook.Sheets("mail").Cells(Rows.Count,
a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1

ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname,
a).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
strdate = Format(Date, "dd-mm-yy") & " " & Format(Time,
"h-mm-ss")
ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a +
1).End(xlUp))
End With
ActiveWorkbook.SendMail MyArr,
ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
ActiveWorkbook.ChangeFileAccess xlReadOnly




Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Next a
End Sub


--
ceemo
------------------------------------------------------------------------
ceemo's Profile: http://www.excelforum.com/member.php...o&userid=10650
View this thread: http://www.excelforum.com/showthread...hreadid=480775

mail
 

I think if you check Ron's site, he probably already has a version that
will do that:

http://www.rondebruin.nl/sendmail.htm

--
Regards,
Tom Ogilvy


"ceemo" wrote in
message ...

All,

I found this code example in the tips section of exceltips.com and i
think this is really useful. I was wondering if it could be modified so
that i could enter a list of email address in column b and get the code
to loop through until it reaches the end rather than having to
re-create the code accross many columns to send the same sheets.

Any help you can provide will be much appreciated.






Mail sheet(s) to one or more people using VBA in Microsoft Excel
VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel
CATEGORY: Mail - Send and Receive in VBA

VERSIONS: All Microsoft Excel Versions
Add new sheet, change the sheet name to mail.
Every mail you want to send will use 3 columns.

1. in column A - enter sheet or sheets name you want to send.
2. in column B - enter E-mail address.
3. in column C - the subject title appears at the top of the E-mail
message.

Column A:C enter information for the first mail and you may use columns
D:F for the second one.
you can send 85 different E-mails this way (85*3 = 255 columns).

Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then Exit
Sub
Application.ScreenUpdating = False
last = ThisWorkbook.Sheets("mail").Cells(Rows.Count,
a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1

ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname,
a).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
strdate = Format(Date, "dd-mm-yy") & " " & Format(Time,
"h-mm-ss")
ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
With ThisWorkbook.Sheets("mail")
MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a +
1).End(xlUp))
End With
ActiveWorkbook.SendMail MyArr,
ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
ActiveWorkbook.ChangeFileAccess xlReadOnly




Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Next a
End Sub


--
ceemo
------------------------------------------------------------------------
ceemo's Profile:
http://www.excelforum.com/member.php...o&userid=10650
View this thread: http://www.excelforum.com/showthread...hreadid=480775

mail
 

Im struggling with this one a bit. I did manage to find code that
allow's me to send to a list of addresses however they dont have the
ability to send to a list of sheets.

Any takers ? :rolleyes:


--
ceemo
------------------------------------------------------------------------
ceemo's Profile: http://www.excelforum.com/member.php...o&userid=10650
View this thread: http://www.excelforum.com/showthread...hreadid=480775

mail
 

You can only sent workbooks, so copy your sheets to a workbook and send
that.

--
Regards,
Tom Ogilvy


"ceemo" wrote in
message ...

Im struggling with this one a bit. I did manage to find code that
allow's me to send to a list of addresses however they dont have the
ability to send to a list of sheets.

Any takers ? :rolleyes:


--
ceemo
------------------------------------------------------------------------
ceemo's Profile:
http://www.excelforum.com/member.php...o&userid=10650
View this thread: http://www.excelforum.com/showthread...hreadid=480775