ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   automatically send email in excel based on value/macro guru stuff (https://www.excelbanter.com/excel-programming/331642-automatically-send-email-excel-based-value-macro-guru-stuff.html)

Michael A

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!


Nigel

automatically send email in excel based on value/macro guru stuff
 
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" wrote in message
...
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!




Michael A

automatically send email in excel based on value/macro guru st
 
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" wrote in message
...
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!






All times are GMT +1. The time now is 02:59 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com