automatically send email in excel based on value/macro guru stuff

Ok, so here is what im trying to do, if any gurus out there can help, I would
greatly appreciate it.

I need a macro that will go to each sheet in a workbook and send that same
page as an email to the email address in B1 on that sheet. If the value is 0
on the sheet in the B1 field then it needs to skip this sheet and move on to
the next. Any help on this would be greatly appreciated.. im unsure where to
start with it. Thankyou!

Hi, Here is solution you might like to try or adapt. It has two procedures
the first MailSheets scans each worksheet in the activeworkbook and if cell
B1 has a value (string > 0) it creates a copy of the worksheet as a new
workbook (same name as the worksheet) and mails it to the contents of B1.
You need to add a reference to Outlook in the VBE.
The second part is the SendMail procedure that takes the email address and
sends the workbook just created. Finally control returns to the first
procedure and the workbook created is then deleted. Only word of caution,
it presumes that the email address in B1 is valid! and that the creation of
a new workbook of the same name as the sheet is acceptable. If it already
exists you get a warning.

Sub MailSheets()
Dim sh As Worksheet, email As String, shName As String
Application.ScreenUpdating = False
For Each sh In Worksheets
email = sh.Range("B1").Value
shName = sh.Name
If Len(email) > 0 Then
sh.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & shName & ".xls"
Call SendMail(email)
ActiveWorkbook.Close False
Kill ThisWorkbook.Path & "\" & shName & ".xls"
End If
Next sh
Application.ScreenUpdating = True
End Sub

' Mailing procedure
Sub SendMail(eMadd As String)
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = eMadd
.CC = ""
.BCC = ""
.Subject = "WorkSheet Mailing"
.Body = "This is an automated email with the attached worksheet"
.Attachments.Add ActiveWorkbook.FullName
'.DeleteAfterSubmit = True ' use this option if you do not want an
entry in the senders sent mail folder
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

--
Cheers
Nigel



"Michael A" <MichaelA@discussions.microsoft.com> wrote in message
news:89D33F29-3FF3-4247-A8AF-90E3A8A08F6C@microsoft.com...
> Ok, so here is what im trying to do, if any gurus out there can help, I
would
> greatly appreciate it.
>
> I need a macro that will go to each sheet in a workbook and send that same
> page as an email to the email address in B1 on that sheet. If the value is
0
> on the sheet in the B1 field then it needs to skip this sheet and move on
to
> the next. Any help on this would be greatly appreciated.. im unsure where
to
> start with it. Thankyou!
>

Nigel, thank you for you help. I will try it and report back.

"Nigel" wrote:

> Hi, Here is solution you might like to try or adapt. It has two procedures
> the first MailSheets scans each worksheet in the activeworkbook and if cell
> B1 has a value (string > 0) it creates a copy of the worksheet as a new
> workbook (same name as the worksheet) and mails it to the contents of B1.
> You need to add a reference to Outlook in the VBE.
> The second part is the SendMail procedure that takes the email address and
> sends the workbook just created. Finally control returns to the first
> procedure and the workbook created is then deleted. Only word of caution,
> it presumes that the email address in B1 is valid! and that the creation of
> a new workbook of the same name as the sheet is acceptable. If it already
> exists you get a warning.
>
> Sub MailSheets()
> Dim sh As Worksheet, email As String, shName As String
> Application.ScreenUpdating = False
> For Each sh In Worksheets
> email = sh.Range("B1").Value
> shName = sh.Name
> If Len(email) > 0 Then
> sh.Copy
> ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & shName & ".xls"
> Call SendMail(email)
> ActiveWorkbook.Close False
> Kill ThisWorkbook.Path & "\" & shName & ".xls"
> End If
> Next sh
> Application.ScreenUpdating = True
> End Sub
>
> ' Mailing procedure
> Sub SendMail(eMadd As String)
> 'You must add a reference to the Microsoft outlook Library
> Dim OutApp As Outlook.Application
> Dim OutMail As Outlook.MailItem
> Set OutApp = CreateObject("Outlook.Application")
> Set OutMail = OutApp.CreateItem(olMailItem)
> With OutMail
> .To = eMadd
> .CC = ""
> .BCC = ""
> .Subject = "WorkSheet Mailing"
> .Body = "This is an automated email with the attached worksheet"
> .Attachments.Add ActiveWorkbook.FullName
> '.DeleteAfterSubmit = True ' use this option if you do not want an
> entry in the senders sent mail folder
> .Send
> End With
> Set OutMail = Nothing
> Set OutApp = Nothing
> End Sub
>
> --
> Cheers
> Nigel
>
>
>
> "Michael A" <MichaelA@discussions.microsoft.com> wrote in message
> news:89D33F29-3FF3-4247-A8AF-90E3A8A08F6C@microsoft.com...
> > Ok, so here is what im trying to do, if any gurus out there can help, I
> would
> > greatly appreciate it.
> >
> > I need a macro that will go to each sheet in a workbook and send that same
> > page as an email to the email address in B1 on that sheet. If the value is
> 0
> > on the sheet in the B1 field then it needs to skip this sheet and move on
> to
> > the next. Any help on this would be greatly appreciated.. im unsure where
> to
> > start with it. Thankyou!
> >
>
>
>