✔ VBA Dashboards Specialist®: VBA Excel - Enviando mais de uma planilhas por eMail

É importante lembrar que ao usar o método SendMail não será possível:

1) Enviar texto no corpo do e-mail

2) Usar o campo CC ou BCC

3) Anexar outros arquivos

Se quiser ter as opções acima e estiver usando o Outlook, poderá usar outro exemplo de modelo de objeto do Outlook.

A sub-rotina a seguir envia uma planilha com as pastas na Matriz:

.Sheets(Array("Plan1", "Plan3")).Copy

Use isto se você quiser enviar as planilhas selecionadas:

TheActiveWindow.SelectedSheets.Copy

É salvando a planilha antes de enviá-la com um carimbo de data / hora.

Depois que o arquivo for enviado para a pasta de trabalho será excluído do seu disco rígido.

Altere o endereço de e-mail e o assunto na macro antes de executá-la.

Nota: se você usar o Windows Live Mail o endereço deverá constar nos seus contatos.

Sub MailSheetsArray()
' Funciona nas versões 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim sh As Worksheet

Dim TheActiveWindow As Window
Dim TempWindow As Window
Dim I As Long

With Application
Let .ScreenUpdating = False
Let .EnableEvents = False

End With

Set Sourcewb = ActiveWorkbook

' Copia a planilha para um novo workbook.
' Adicionamos uma janela temporária para evitar o problema de cópia.

' Se houver uma lista ou tabela numa das sheets e as sheets se agrupem caso exista uma lista ou tabela em uma das folhas.

With Sourcewb
Set TheActiveWindow = ActiveWindow

Set TempWindow = .NewWindow

.Sheets(Array("Sheet1", "Sheet3")).Copy
End With

' Fecha a janela temporária

TempWindow.Close

Set Destwb = ActiveWorkbook

'Determina a versão do MS Excel e o tipo de extensão.
With Destwb
If Val(Application.Version) < 12 Then

'Excel 97-2003
Let FileExtStr = ".xls": FileFormatNum = -4143
Else
'Se for a versão 2007-2010 do Excel, Saímos da sub quando sua resposta for

'NO no diálogo de segurança que você só vê quando copia
'a planilha de um arquivo xlsm com macro estiver desativada.
If Sourcewb.Name = .Name Then

With Application
Let .ScreenUpdating = True
Let .EnableEvents = True
End With

MsgBox "Sua resposta é NO na janela de segurança."

Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51

Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51

End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select

End If
End If
End With

' Salva a nova planilha/Envia o e-Mail/Deleta o
Let TempFilePath = Environ$("temp") & "\"

Let TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

On Error Resume Next

For I = 1 To 3
.SendMail "bernardess@gmail.com", "Aqui está a linha de Assunto (Subject)"

If Err.Number = 0 Then Exit For
Next I

On Error GoTo 0
.Close SaveChanges:=False
End With

'Deleta o arquivo que foi enviado
Kill TempFilePath & TempFileName & FileExtStr

With Application
Let .ScreenUpdating = True
Let .EnableEvents = True

End With
End Sub