Create an Outlook email from a tab vs workbook

[gheyman]

I have code that will generate an outlook email and attach the workbook

what if I wanted to be able to do this for individual tabs within my workbook. I want to be able to go to a tab and generate a an outlook email that just attached "the tab" (I know you can literally attach only a tab - assume it would have to be something like exporting the tab and then use it as an attachment....)

any help is greatly appreciated. If at all possible, I would like the attachment be two of the tabs. But that might be too complicated. I can possible combine the information of the two tabs onto one.

In my head its something like the user identifies which tab(s), code exports them to a new workbook where the user can name it, them it is attached to an email and the email address, body.... is autofill using data from cells in the new workbook. I could be off on the best way to do this.

Sub GenerateEmail()
'Create Email


If Sheets("ModelGeneral vluEmployee").Range("E2").Text <> "Match" Then
    MsgBox "Sorry, but you must be a DRS Employee to use this function"

Else

  
   If Sheets("Supplier").Range("E8").Value <> "" Then
   
 MsgBox "Note: Once you create an email, your login will be wipped clean so that the workbook that gets attached to the email no longer has your credentials"
 
Sheets("ModelGeneral vluEmployee").Range("B2").ClearContents
Sheets("ModelGeneral vluEmployee").Range("B3").ClearContents

Sheets("ModelGeneral vluVendor").Visible = xlSheetVeryHidden
Sheets("ModelGeneral vluEmployee").Visible = xlSheetVeryHidden
Sheets("ModelGeneral vluVendorContactIn").Visible = xlSheetVeryHidden
Sheets("ModelGeneral vluVendor Default").Visible = xlSheetVeryHidden


Sheets("Supplier").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    


      With CreateObject("outlook.application").createitem(0)
        .To = Sheets("Supplier").Range("E11")
        .CC = ""
        .BCC = ""
        .Subject = "Leonardo DRS - Open PO Status Request. Please Complete the attached and Return ASAP.  " & Sheets("Supplier").Range("C17")
        .body = Sheets("Supplier").Range("E10") & vbNewLine & vbNewLine & "Attched please find Leonardo DRS - NIS PO Status Report." & vbNewLine & vbNewLine & "We formally request you complete the attached Template (Tab: PO Status) and return it to the sender as soon as possible." & vbNewLine & vbNewLine & "If you have any questions, please contact the sender." & vbNewLine & vbNewLine & "We thank you for your continued support" & vbNewLine & vbNewLine & Sheets("Supplier").Range("C15") & vbNewLine & vbNewLine & Sheets("Supplier").Range("C16")
        .attachments.Add ThisWorkbook.FullName
        .display
     End With
     
     
     
     Else
     
     MsgBox " It appears that you did not list a Contact Email address in E5"
     Sheets("Supplier").Range("E8").Select
     
   End If
   
End If
   
End Sub

 

[Domenic]

Try to adapt the following code, which will copy two worksheets from the source workbook to a temporary new workbook, save the new workbook to your temporary folder, attach the new workbook to your email, and then delete the workbook. Change the name of the two sheets accordingly. Also, note that the new workbook is named the same as the source workbook, except that it's saved with the file extension .xlsx instead of .xlsm. Change the name of the new workbook as desired.

    Dim wbSource As Workbook
    Set wbSource = ThisWorkbook

    Dim wbDest As Workbook
    Set wbDest = Workbooks.Add(xlWBATWorksheet)

    wbSource.Sheets(Array("Sheet1", "Sheet3")).Copy after:=wbDest.Sheets(wbDest.Sheets.Count)
    
    Application.DisplayAlerts = False
    wbDest.Sheets(1).Delete
    Application.DisplayAlerts = True
    
    Dim tempFilename As String
    tempFilename = Environ("temp") & "\" & Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1) & ".xlsx"
    
    wbDest.SaveAs Filename:=tempFilename, FileFormat:=51
    
    wbDest.Close SaveChanges:=False
    
    'your code here to create the email and attach the workbook
    '
    '
    
    Kill tempFilename

Hope this helps!

 

[gheyman]

Thank You!