mail.
Obs 1: Alterar o assunto e a mensagem marcados em negrito
Obs 2: .CC e .BCC são opcionais, utilize apenas para os casos enviar cópias e
cópias ocultas respectivamente.
Obs 3: O commando. Send marcado em negrito faz o e-mail ser enviado
automaticamente, se trocar por .Display , o e-mail será apenas criado e
deixado pronto, porém não será enviado.
Sub SendActiveSheetEmail ()
Dim Exten As String
Dim FormtN As Long
Dim OutApp As Object
Dim OutMail As Object
Dim OriginWKB As Workbook
Dim DestWKB As Workbook
Dim TempFilePath As String
Dim TempFileFolder As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set OriginWKB = ActiveWorkbook
ActiveSheet.Copy
Set DestWKB = ActiveWorkbook
With DestWKB
If Val(Application.Version) < 12 Then
Exten = ".xls": FormtN = -4143
Else
Select Case OriginWKB.FileFormat
Case 51: Exten = ".xlsx": FormtN = 51
Case 52:
If .HasVBProject Then
Exten = ".xlsm": FormtN = 52
Else
Exten = ".xlsx": FormtN = 51
End If
Case 56: Exten = ".xls": FormtN = 56