VBA – Enviar planilhas por e-mail como pastas de trabalho separadas

Written by

Mel Jenkins

Reviewed by

Steve Rynearson

Translated by

Daniel Caramello

Last updated on September 11, 2023

Esse código salva uma planilha como uma nova pasta de trabalho e cria um e-mail no Outlook com a nova pasta de trabalho anexada. É muito útil se você tiver uma planilha modelo padronizada que é usada em toda a sua organização.

Para obter um exemplo mais simples, consulte Como enviar e-mail do Excel.

Salvar Planilha como Nova Pasta de Trabalho e Anexar ao E-Mail

Sub EMail_PastaDeTrabalho()
Application.DisplayAlerts = False
Application.enableevents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim OutApp As Object
Dim OutMail As Object
Dim FilePath As String
Dim Project_Name As String
Dim Template_Name As String
Dim ReviewDate As String
Dim SaveLocation As String
Dim Path As String
Dim Name As String

'Criar variáveis iniciais
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Project_Name = Sheets("Planilha1").Range("NomeDoProjeto").Value
Template_Name = ActiveSheet.Name

'Pedir entrada usada no e-mail
ReviewDate = InputBox(Prompt:="Forneça a data até a qual você gostaria que o envio fosse revisado.", Title:="Inserir Data", Default:="MM/DD/YYYYY")

If ReviewDate = "Inserir Data" Or ReviewDate = vbNullString Then GoTo endmacro

'Salvar planilha como pasta de trabalho própria
Path = ActiveWorkbook.Path
 Name = Trim(Mid(ActiveSheet.Name, 4, 99))


Set ws = ActiveSheet
Set oldWB = ThisWorkbook

SaveLocation = InputBox(Prompt:="Escolha o nome e o local do arquivo", Title:="Salvar Como", Default:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/" & Name & ".xlsx")

 If Dir(SaveLocation) <> "" Then
 MsgBox ("Já existe um arquivo com esse nome. Escolha um novo nome ou exclua o arquivo existente.")
 SaveLocation = InputBox(Prompt:="Escolha o nome e o local do arquivo", Title:="Salvar Como", Default:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "/" & Name & ".xlsx")
 End If
    
If SaveLocation = vbNullString Then GoTo endmacro

'desproteger a planilha, se necessário
ActiveSheet.Unprotect Password:="senha"

Set newWB = Workbooks.Add

'Ajustar a exibição
ActiveWindow.Zoom = 80
ActiveWindow.DisplayGridlines = False

'Copiar + Colar Valores
oldWB.Activate
oldWB.ActiveSheet.Cells.Select
Selection.Copy
newWB.Activate
newWB.ActiveSheet.Cells.Select

 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
        
     
'Selecionar novo WB e desativar o modo cutcopy
 newWB.ActiveSheet.Range("A10").Select
 Application.CutCopyMode = False
    
'Salvar arquivo
 newWB.SaveAs Filename:=SaveLocation, _
 FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

FilePath = Application.ActiveWorkbook.FullName
    
'Reproteger oldWB
oldWB.ActiveSheet.Protect Password:="senha", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
 AllowFormattingRows:=True

'Email
On Error Resume Next
With OutMail
.to = "email@email.com"
.CC = ""
.BCC = ""
.Subject = Project_Name & ": " & Template_Name & " para revisão"
.Body = "Project Name: " & Project_Name & ", " & Name & " Para revisão de " & ReviewDate
.Attachments.Add (FilePath)
.Display
' .Send 'Opcional para automatizar o envio do e-mail.
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

'Finalizar macro, restaurar atualização de tela, cálculos, etc.
endmacro:
Application.DisplayAlerts = True
Application.enableevents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Codificação VBA facilitada

Pare de procurar códigos VBA on-line. Saiba mais sobre o AutoMacro – um construtor de código VBA que permite que os iniciantes codifiquem procedimentos do zero com o mínimo de conhecimento de codificação e com muitos recursos que economizam tempo para todos os usuários!

alt text

Saiba mais!

<<Retornar aos exemplos de VBA

vba-free-addin

Exemplos de Add-ins de Códigos VBA

Acesse facilmente todos os exemplos de código que se encontram em nosso site.

Simply navigate to the menu, click, and the code will be inserted directly into your module. .xlam add-in.

(Nenhuma instalação necessária!)

Baixe de Graça

Retornar aos Exemplos de Códigos VBA