Generate a file and attach in the email with vba

Question

I did a macro where she opens the outlook, until then beauty. now I need to complement her with the following items.

I need to take 4 tabs of my spreadsheet, generate a new file and then attach in the email and send.

Someone can help me?

follows the code ( this code only opens excel )

Sub MandaEmail()

    Dim EnviarPara As String
    Dim Mensagem As String
    For i = 1 To 1
        EnviarPara = Worksheets("Tabela").Cells(5, 35)
        If EnviarPara <> "" Then
            Mensagem = Worksheets("Tabela").Cells(6, 35)
            Texto = Worksheets("Tabela").Cells(7, 35)
            Envia_Emails EnviarPara, Mensagem
        End If
    Next i
End Sub
Sub Envia_Emails(EnviarPara As String, Mensagem As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = EnviarPara
        .CC = ""
        .BCC = ""
        .Subject = Mensagem
        .Body = "Bom dia"
        .Display ' para envia o email diretamente defina o código  .Send
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

Answer 1

Code

Sub MandaEmail()

    Dim EnviarPara As String
    Dim Mensagem As String, caminho As String, Texto As String
    Dim wb As Workbook
    'Criar Arquivo
    caminho = ThisWorkbook.Path & "\" & "temp.xlsx"
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(Array("Planilha1", "Planilha2", "Planilha3", "Planilha4")).Copy
    ActiveWorkbook.SaveAs Filename:=caminho, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

    'Enviar Email
    For i = 1 To 1
        EnviarPara = Worksheets("Tabela").Cells(1, "A")
        If EnviarPara <> "" Then
            Mensagem = Worksheets("Tabela").Cells(2, "A")
            Texto = Worksheets("Tabela").Cells(3, "A")
            Envia_Emails EnviarPara, Mensagem, caminho, Texto
        End If
    Next i

    Kill caminho 'Deleta o arquivo

    Application.DisplayAlerts = True
End Sub

Sub Envia_Emails(EnviarPara As String, Mensagem As String, caminho As String, Texto As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .Display
        Signature = .HTMLbody
        .To = EnviarPara
        .CC = ""
        .BCC = ""
        .Subject = Mensagem
        .Attachments.Add caminho
        .HTMLbody = "Bom dia" &  "<br>"& Texto &  "<br>" & Signature
        .Display                                 ' para envia o email diretamente defina o código  .Send
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

Explanation

You add attachment in Outlook with .Attachments.Add

And creates a new Excel file with the desired spreadsheets with: ThisWorkbook.Sheets(Array("Planilha1", "Planilha2", "Planilha3", "Planilha4")).Copy

Then save the spreadsheet in the same folder as the excel file: ActiveWorkbook.SaveAs Filename:=caminho, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False and at the end of the program delete this Excel file Kill caminho

For other ways to insert tables in the body of the email, see this answer