Hi All, I would appreciate any assistance you experts could give me. Thank you in advance.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com
fficeffice" /><o> </o>
I use the below code to e-mail the active sheet in my workbook and it works well.
<o> </o>
However my workbook has many sheets and its taking me a very very long time to go into each sheet and e-mail. Each sheet need to go to a separate e-mail address. My code also stops and requires me to hit the send button I would like to eliminate this step and have it sent automatically when I run the code.
<o> </o>
I guess what I'm asking is there a way to call out in the code specific sheets to go to specific e-mail addresses?
<o> </o>
For example.
<o> </o>
Workbook monthlyreport has “sheet1=325” “sheet2=326” “sheet3=327” and so on…
<o> </o>
“sheet1” 325 needs to be e-mailed to tom@home.com;jim@home.com;
“sheet2” 326 needs to be e-mailed to mike@work.com;dean@homework.com
“sheet3” 327 needs to be e-mailed to david@worksite.com;richard@mainoffice.com
And so on.
<o> </o>
Thanks
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com
fficeffice" /><o> </o>I use the below code to e-mail the active sheet in my workbook and it works well.
<o
> </o>However my workbook has many sheets and its taking me a very very long time to go into each sheet and e-mail. Each sheet need to go to a separate e-mail address. My code also stops and requires me to hit the send button I would like to eliminate this step and have it sent automatically when I run the code.
<o
> </o>I guess what I'm asking is there a way to call out in the code specific sheets to go to specific e-mail addresses?
<o
> </o>For example.
<o
> </o>Workbook monthlyreport has “sheet1=325” “sheet2=326” “sheet3=327” and so on…
<o
> </o>“sheet1” 325 needs to be e-mailed to tom@home.com;jim@home.com;
“sheet2” 326 needs to be e-mailed to mike@work.com;dean@homework.com
“sheet3” 327 needs to be e-mailed to david@worksite.com;richard@mainoffice.com
And so on.
<o
> </o>Thanks
Code:
Sub Email_Tabs()
'
' Email_Tabs Macro
'
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
ActiveSheet.Unprotect
Set Source = Nothing
On Error Resume Next
Set Source = Cells 'Range("A1:J12000").SpecialCells(xlCellTypeVisible)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xls": FileFormatNum = -4143
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "[EMAIL="Enter_your_to_e-mail_here@e-mail.com"]Enter_your_to_e-mail_here@e-mail.com[/EMAIL]"
.CC = ""
.BCC = ""
.Subject = "Enter_Your_Subject_Here"
.Body = "Enter the text you want in the body of your e-Mail here. Thank You."
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'
End Sub
