ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help on e-mailing worksheets (https://www.excelbanter.com/excel-programming/372102-help-e-mailing-worksheets.html)

ell7

Help on e-mailing worksheets
 
Hi, I have adapted some code posted on here in order to e-mail each
sheet in a workbook to the e-mail addresses entered into cell A1 on
each sheet. What I would like to do is to break all the links in the
new workbooks before they are sent. I would also like to insert a
message box asking to confirm the action before it is carried out (ie -
"e-mail separate sheets?" Yes/No/Cancel)
Any help would be very much appreciated - Thanks!
The existing code I have is as follows:
Sub email_worksheets2()
Dim sh As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Cost Centre Reporting - " & sh.Name & ".xls"
.SendMail ActiveSheet.Range("a1").Value, _
"Please find attached your detailed " & sh.Name & "
cost centre report"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
Next sh
Application.ScreenUpdating = True
End Sub


Ron de Bruin

Help on e-mailing worksheets
 
Hi ell7

message box asking to confirm the action before it is carried out

For every sheet ? or only when you start the macro

What I would like to do is to break all the links

Formula links ?

I change the macro for you when you answer the questions



--
Regards Ron de Bruin
http://www.rondebruin.nl



"ell7" wrote in message oups.com...
Hi, I have adapted some code posted on here in order to e-mail each
sheet in a workbook to the e-mail addresses entered into cell A1 on
each sheet. What I would like to do is to break all the links in the
new workbooks before they are sent. I would also like to insert a
message box asking to confirm the action before it is carried out (ie -
"e-mail separate sheets?" Yes/No/Cancel)
Any help would be very much appreciated - Thanks!
The existing code I have is as follows:
Sub email_worksheets2()
Dim sh As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Cost Centre Reporting - " & sh.Name & ".xls"
.SendMail ActiveSheet.Range("a1").Value, _
"Please find attached your detailed " & sh.Name & "
cost centre report"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
Next sh
Application.ScreenUpdating = True
End Sub




ell7

Help on e-mailing worksheets
 
Hi Ron - thanks for your quick reply. I only need one message box for
when I start the macro. And, yes, I want to break the formula links to
external references. I have a lot of references to files that the
recipients of the worksheets do not have access to, so I would like to
break these links. I would prefer to do this rather than simply to
convert the formulae to values as I would like to retain the internal
formulae within the sheet itself.
Thanks in advance for your help.


Ron de Bruin

Help on e-mailing worksheets
 
Hi ell7

Test this one for me and post back if this is what you want

Sub Email_worksheets_Break_links_Test()
Dim sh As Worksheet
Dim wb As Workbook
Dim WorkbookLinks As Variant
Dim i As Long
Dim Answer

Answer = MsgBox("Do you want to mail all sheets that have a mail address in A1 ?", _
vbYesNo, "Ron's code test!")

If Answer = vbYes Then

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook

WorkbookLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(WorkbookLinks) Then
For i = 1 To UBound(WorkbookLinks)
wb.BreakLink _
Name:=WorkbookLinks(i), _
Type:=xlLinkTypeExcelLinks
Next i
Else
' No Links to other workbooks"
End If

With wb
.SaveAs "Cost Centre Reporting - " & sh.Name & ".xls"
.SendMail wb.Sheets(1).Range("a1").Value, _
"Please find attached your detailed " & sh.Name & " cost centre report"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
Next sh
Application.ScreenUpdating = True

Else
MsgBox "You not want to run the macro"
End If

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"ell7" wrote in message ups.com...
Hi Ron - thanks for your quick reply. I only need one message box for
when I start the macro. And, yes, I want to break the formula links to
external references. I have a lot of references to files that the
recipients of the worksheets do not have access to, so I would like to
break these links. I would prefer to do this rather than simply to
convert the formulae to values as I would like to retain the internal
formulae within the sheet itself.
Thanks in advance for your help.




ell7

Help on e-mailing worksheets
 
Absolutely fantastic - it works like a dream!! Thank you so much.

One more question - is there any way to enter text into the actual body
of the e-mail, rather than just the subject box? Say for example
"please find attached your detailed cost centre analysis...."


Ron de Bruin

Help on e-mailing worksheets
 

Hi ell7

Absolutely fantastic - it works like a dream!! Thank you so much.

Great

One more question - is there any way to enter text into the actual body
of the e-mail, rather than just the subject box? Say for example
"please find attached your detailed cost centre analysis...."


Not with SendMail but if you use Outlook you can use code that use the Outlook object model.
See this page for a example
http://www.rondebruin.nl/mail/folder2/mail5.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"ell7" wrote in message ups.com...
Absolutely fantastic - it works like a dream!! Thank you so much.

One more question - is there any way to enter text into the actual body
of the e-mail, rather than just the subject box? Say for example
"please find attached your detailed cost centre analysis...."




ell7

Help on e-mailing worksheets
 
Thanks Ron - you've been a great help



All times are GMT +1. The time now is 07:41 AM.

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