Attachment in email

[vmjan02]

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

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

 

[Micron]

Maybe (untested)

Dim ws As Worksheet 'I declare variables all together at the top

'prior code here

For Each ws In ThisWorkbook.Sheets
  If ws.Name = "Print Revenue" Or ws.Name = "MS Festival Pivot" Or ws.Name = "CC Festivla Pivot" Or ws.Name = "Print DB Festival RawData" Then
    Outmail.Attachments.Add
  End If
Next

'rest of code
'Get its Word editor
outMail.Display

The reason I didn't use the With block for .Attachments is that I presumed you want to send regardless of which mail header values are used, so no need to put the same thing in both of you If blocks. I suppose there are more elegant ways rather than 4 Or operators.

 

[Micron]

BTW, I'm assuming you can add a sheet as an attachment but am beginning to suspect that you cannot. I was answering for how to loop over your sheets, which may have been presumptuous on my part. I would have to test - sorry.

 

[vmjan02]

Maybe (untested)

Dim ws As Worksheet 'I declare variables all together at the top

'prior code here

For Each ws In ThisWorkbook.Sheets
  If ws.Name = "Print Revenue" Or ws.Name = "MS Festival Pivot" Or ws.Name = "CC Festivla Pivot" Or ws.Name = "Print DB Festival RawData" Then
    Outmail.Attachments.Add
  End If
Next

'rest of code
'Get its Word editor
outMail.Display

The reason I didn't use the With block for .Attachments is that I presumed you want to send regardless of which mail header values are used, so no need to put the same thing in both of you If blocks. I suppose there are more elegant ways rather than 4 Or operators.

it's not working and giving me an error on outmail.attachments.add

 

[Micron]

Upon researching, it seems that the only way to send a sheet is to Copy it/them to a new workbook and send that. Lots of example code if you google
send excel sheet as attachment vba
HTH

 

[vmjan02]

Upon researching, it seems that the only way to send a sheet is to Copy it/them to a new workbook and send that. Lots of example code if you google
send excel sheet as attachment vba
HTH

yes. Thanks for the help, have solved it.
here is the code.

and calling this saveattachments in my email code.

Sub SaveAttachents()
    Sheets(Array("Print Revenue", "MS Festival Pivot", "CC Festivla Pivot", _
        "Print DB Festival RawData")).Select
    Sheets("Print DB Festival RawData").Activate
    Sheets(Array("Print Revenue", "MS Festival Pivot", "CC Festivla Pivot", _
        "Print DB Festival RawData")).Copy
    ChDir "D:\"
    Kill "D:\Print Raw Data.xlsx"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Print Raw Data.xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
    Sheets("Report").Select
    Range("E7").Select
End Sub

'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
 
'Call SaveAttachents
'outMail.Attachments Filename

'' Attachment to email
path = "D:\"
Filename = path & "Print Raw Data.xlsx"
outMail.Attachments.Add Filename