Este tutorial mostrará como enviar e-mails do Excel por meio do Outlook usando o VBA.
Enviando a pasta de trabalho ativa
| 1234567891011121314151617181920 | Função SendActiveWorkbook (strTo As String, strSubject As String, Opcional strCC As String, Opcional strBody As String) As BooleanOn Error Resume NextDim appOutlook As ObjectDim mItem As Object'criar uma nova instância do OutlookDefinir appOutlook = CreateObject ("Outlook.Application")Definir mItem = appOutlook .CreateItem (0)Com mItem.To = strTo.CC = "".Subject = strSubject.Body = strBody.Attachments.Add ActiveWorkbook.FullName'use enviar para enviar imediatamente ou exibir para mostrar na tela.Display 'ou .SendTerminar com'limpar objetosDefinir mItem = NothingDefinir appOutlook = NothingFunção Final |
A função acima pode ser chamada usando o procedimento abaixo
| 123456789101112131415 | Sub SendMail ()Dim strTo As StringDim strSubject As StringDim strBody As String'preencher variáveisstrTo = "[email protected]"strSubject = "Encontre o arquivo financeiro em anexo"strBody = "algum texto vai aqui para o corpo do e-mail"'chame a função para enviar o e-mailSe SendActiveWorkbook (strTo, strSubject,, strBody) = true entãoMsgbox "Criação de e-mail com sucesso"OutroMsgbox "Falha na criação do e-mail!"Fim seEnd Sub |
Usando Early Binding para se referir à Biblioteca de Objetos do Outlook
O código acima usa Late Binding para se referir ao objeto Outlook. Você pode adicionar uma referência ao Excel e declarar o aplicativo Outlook e o Outlook Mail Item usando Early Binding, se preferir. A vinculação antecipada torna o código executado mais rápido, mas limita você, pois o usuário precisa ter a mesma versão do Microsoft Office em seu PC.
Clique no menu Ferramentas e Referências para mostrar a caixa de diálogo de referência.
Adicione uma referência à Biblioteca de Objetos do Microsoft Outlook para a versão do Office que você está usando.
Você pode então corrigir seu código para usar essas referências diretamente.
Uma grande vantagem da vinculação inicial são as listas suspensas que mostram os objetos disponíveis para uso!
Envio de uma única folha da pasta de trabalho ativa
Para enviar uma única planilha, primeiro você precisa criar uma nova pasta de trabalho a partir da pasta de trabalho existente com apenas aquela planilha nela e, em seguida, enviar essa planilha.
| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849 | Função SendActiveWorksheet (strTo As String, strSubject As String, Opcional strCC As String, Opcional strBody As String) As BooleanOn Error GoTo eh'declara variáveis para conter os objetos necessáriosDim wbDestination As WorkbookDim strDestName As StringDim wbSource As WorkbookDim wsSource As WorksheetDim OutApp como objetoDim OutMail como objetoDim strTempName As StringDim strTempPath As String'primeiro criar pasta de trabalho de destinoDefina wbDestination = Workbooks.AddstrDestName = wbDestination.Name'definir a planilha e a pasta de trabalho de origemDefinir wbSource = ActiveWorkbookDefina wsSource = wbSource.ActiveSheet'copia a planilha ativa para a nova pasta de trabalhowsSource.Copy After: = Workbooks (strDestName) .Sheets (1)'salvar com um nome temporáriostrTempPath = Environ $ ("temp") & "\"strTempName = "Lista obtida de" & wbSource.Name & ".xlsx"Com wbDestination.SaveAs strTempPath & strTempName'agora envie por e-mail a pasta de trabalho de destinoDefinir OutApp = CreateObject ("Outlook.Application")Definir OutMail = OutApp.CreateItem (0)Com OutMail.To = strTo.Subject = strSubject.Body = strBody.Attachments.Add wbDestination.FullName'use enviar para enviar imediatamente ou exibir para mostrar na tela.Display 'ou .DisplayTerminar com.Close FalseTerminar com'delete a pasta de trabalho temporária que você anexou ao seu e-mailMate strTempPath e strTempName'limpar os objetos para liberar a memóriaDefinir wbDestination = NothingDefinir wbSource = NothingDefina wsSource = NothingDefinir OutMail = NadaDefinir OutApp = NadaFunção de saídaEh:MsgBox Err.DescriptionFunção Final |
e para executar esta função, podemos criar o seguinte procedimento
| 12345678910111213 | Sub SendSheetMail ()Dim strTo As StringDim strSubject As StringDim strBody As StringstrTo = "[email protected]"strSubject = "Encontre o arquivo financeiro em anexo"strBody = "algum texto vai aqui para o corpo do e-mail"Se SendActiveWorksheet (strTo, strSubject,, strBody) = True ThenMsgBox "Criação de e-mail com sucesso"OutroMsgBox "Falha na criação do e-mail!"Fim seEnd Sub |
