I have this code and is working all perfect, on think is I am not able to modify the code to attach .Sheets(Array("Print Revenue", "MS Festival Pivot", "CC Festivla Pivot", "Print DB Festival RawData"))
Any anyone help to modify the code to do multiple sheet attachments in email
Any anyone help to modify the code to do multiple sheet attachments in email
VBA Code:
Sub Mail_Selection_Range_Outlook_Body()
Dim r As Range
Sheets("AM Dashboard").Select
Set r = Sheets("AM Dashboard").Range("E1:T35")
r.Copy
'Paste as picture in sheet and cut immediately
Dim p As Picture
Set p = ActiveSheet.Pictures.Paste
p.Cut
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
If Sheets("AM Dashboard").Range("e2").Value = "DR" Then
With outMail
.To = Sheets("Email").Range("C9").Value
.CC = Sheets("Email").Range("C10").Value
.BCC = Sheets("Email").Range("C11").Value
.Subject = Sheets("Email").Range("C12").Value
End With
End If
If Sheets("AM Dashboard").Range("e2").Value = "CRO" Then
With outMail
.To = Sheets("Email").Range("C15").Value
.CC = Sheets("Email").Range("C16").Value
.BCC = Sheets("Email").Range("C17").Value
.Subject = Sheets("Email").Range("C18").Value
End With
End If
'Get its Word editor
outMail.Display
Dim wordDoc As Word.document
Set wordDoc = outMail.GetInspector.WordEditor
'Paste picture
wordDoc.Range.Paste
Z = wordDoc.InlineShapes.Count
wordDoc.InlineShapes.Item(Z).ScaleHeight = 85
End Sub