Ir para o conteúdo principal

Como enviar e-mail se o botão for clicado no Excel?

Autor: Siluvia Última modificação: 2020-07-22

Supondo que você precise enviar e-mail pelo Outlook clicando em um botão na planilha do Excel, como pode fazer? Este artigo apresentará um método VBA para obtê-lo em detalhes.

Enviar e-mail se o botão for clicado com o código VBA


Enviar e-mail se o botão for clicado com o código VBA

Faça o seguinte para enviar um e-mail pelo Outlook se um botão de comando for clicado na pasta de trabalho do Excel.

1. Insira um botão de comando em sua planilha clicando em Developer > inserção > Botão de comando (controle ActiveX). Veja a imagem:

2. Clique com o botão direito do mouse no botão de comando inserido e clique em Ver código no menu do botão direito como mostra a captura de tela abaixo.

3. Na abertura Microsoft Visual Basic para Aplicações janela, substitua o código original na janela Código com o seguinte script VBA.

Código VBA: Enviar e-mail se o botão for clicado no Excel

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Body content" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
                  On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "Test email send by button clicking"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Notas:

1). Altere o corpo do e-mail conforme necessário no xMailBody linha no código.

2). Substitua o Email com o endereço de e-mail do destinatário alinhado .To = "Endereço de e-mail".

3). Especifique os destinatários Cc e Bcc conforme necessário em .CC = “” e .Cco = “” .

4). Altere o assunto do e-mail na linha .Subject = "Enviar email de teste clicando no botão".

4. aperte o outro + Q simultaneamente para fechar o Microsoft Visual Basic para Aplicações janela.

5. Desative o modo de design clicando em Developer > Modo de design. Veja a imagem:

A partir de agora, cada vez que você clicar no Botão de Comando, um e-mail será criado automaticamente com destinatários, assunto e corpo especificados. Envie o e-mail clicando no ENVIAR botão.

Note: O código VBA só funciona quando você usa o Outlook como seu programa de e-mail.

Envie e-mails facilmente pelo Outlook com base nos campos da lista de e-mails criada no Excel:

A Mande emails utilidade de Kutools for Excel ajuda a enviar e-mail através do Outlook com base nos campos da lista de discussão criada no Excel.
Baixe e experimente agora! (trilha gratuita de 30 dias)


Artigos relacionados:

Melhores ferramentas de produtividade de escritório

🤖 Assistente de IA do Kutools: Revolucionar a análise de dados com base em: Execução Inteligente   |  Gerar Código  |  Crie fórmulas personalizadas  |  Analise dados e gere gráficos  |  Invocar funções do Kutools...
Recursos mais comuns: Encontre, destaque ou identifique duplicatas   |  Excluir linhas em branco   |  Combine colunas ou células sem perder dados   |   Rodada sem Fórmula ...
Super pesquisa: VLookup de múltiplos critérios    VLookup de múltiplos valores  |   VLookup em várias planilhas   |   Pesquisa Difusa ....
Lista suspensa avançada: Crie rapidamente uma lista suspensa   |  Lista suspensa de dependentes   |  Lista suspensa de seleção múltipla ....
Gerenciador de colunas: Adicione um número específico de colunas  |  Mover colunas  |  Alternar status de visibilidade de colunas ocultas  |  Compare intervalos e colunas ...
Recursos em destaque: Foco da Grade   |  Vista de Design   |   Grande Barra de Fórmula    Gerenciador de pastas de trabalho e planilhas   |  Biblioteca (Auto texto)   |  Data Picker   |  Combinar planilhas   |  Criptografar/Descriptografar Células    Enviar e-mails por lista   |  Super Filtro   |   Filtro Especial (filtro negrito/itálico/tachado...) ...
15 principais conjuntos de ferramentas12 Texto Ferramentas (Adicionar texto, Remover Personagens, ...)   |   50+ de cores Tipos (Gráfico de Gantt, ...)   |   Mais de 40 práticos Fórmulas (Calcule a idade com base no aniversário, ...)   |   19 Inclusão Ferramentas (Insira o código QR, Inserir imagem do caminho, ...)   |   12 Conversão Ferramentas (Números para Palavras, Conversão de moedas, ...)   |   7 Unir e dividir Ferramentas (Combinar linhas avançadas, Dividir células, ...)   |   ... e mais

Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo.  Clique aqui para obter o recurso que você mais precisa...

Descrição


Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
Comments (76)
Rated 3.5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hi,

How do I send only one sheet from my workbook and not the whole workbook with the submitting button?
This comment was minimized by the moderator on the site
Hi Diana,
Please try if the following VBA code can help.
Before using this code, make sure to replace ThisWorkbook.Sheets("Sheet1") with the actual name of the worksheet you want to attach. Also, be sure to set the email’s .To property to the actual recipient’s address.

This code creates a temporary workbook file in your temp folder, attaches it to an email, and then shows this email. After showing the email, it will delete the temporary file. If you prefer to send the email directly without displaying it, you can replace the .Display method with .Send.

Private Sub CommandButton1_Click()
'Updated by Extendoffice 20240411
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim xSheet As Worksheet
    Dim xTempWorkbook As Workbook
    Dim xTempFilePath As String
    Dim xTempFileName As String

    On Error GoTo ErrHandler
    ' Set the name of the worksheet you want to attach (e.g., "Sheet1")
    Set xSheet = ThisWorkbook.Sheets("Sheet1")

    ' Create the path and filename for the temporary file
    xTempFilePath = Environ$("TEMP") & "\"
    xTempFileName = "TempWorkbook" & Format(Now, "yyyymmddhhmmss") & ".xlsx"

    ' Copy the worksheet to a new workbook
    xSheet.Copy
    Set xTempWorkbook = ActiveWorkbook

    ' Save the new workbook as a temporary file
    xTempWorkbook.SaveAs xTempFilePath & xTempFileName

    ' Close the new workbook
    xTempWorkbook.Close SaveChanges:=False

    ' Create the Outlook application and Mail item
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)

    ' Set the email body content
    xMailBody = "Body content" & vbNewLine & vbNewLine & _
                "This is line 1" & vbNewLine & _
                "This is line 2"

    ' Set up the email details and display the email
    With xOutMail
        .To = "" ' Set the recipient's email address
        .CC = ""
        .BCC = ""
        .Subject = "Test email sent by button clicking"
        .Body = xMailBody
        .Attachments.Add xTempFilePath & xTempFileName ' Attach the file
        .Display ' or use .Send to send the email directly
    End With

    Kill xTempFilePath & xTempFileName

    Set xOutMail = Nothing
    Set xOutApp = Nothing
    Set xSheet = Nothing
    Exit Sub

ErrHandler:
    MsgBox "An error has occurred: " & Err.Description
End Sub
This comment was minimized by the moderator on the site
Why is it that the filename of the attachment has the %20 filled in for the spaces? How to remove them and have the original file name, Price Discrepancy form.xlsm instead of Price%20Discrepancy%20form.xlsm?
Thank you.
This comment was minimized by the moderator on the site
Hi There,

I want to be able to attach a spreadsheet to an email and send it off, however, the difference is in the spreadsheet there is a date in cell A1 and description of works in cell A3, I want to be able to combine those and rename the spreadsheet to the attachments as per the date and description of works.

Thanks
This comment was minimized by the moderator on the site
Hi Fadi,
The following VBA code can do you a favor. Please give it a try. Thank you.
Private Sub CommandButton1_Click()

    'Update 20221123
    Dim xFile As String
    Dim xFormat As Long
    Dim Wb As Workbook
    Dim Wb2 As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    On Error Resume Next
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
    
    FileName = Format(ActiveSheet.Range("A1").Value, "dd-mmm-yy") & " " & ActiveSheet.Range("A3").Value
    Set Wb = Application.ActiveWorkbook
    ActiveSheet.Copy
    Set Wb2 = Application.ActiveWorkbook
    Select Case Wb.FileFormat
    Case xlOpenXMLWorkbook:
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    Case xlOpenXMLWorkbookMacroEnabled:
        If Wb2.HasVBProject Then
            xFile = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            xFile = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
    Case Excel8:
        xFile = ".xls"
        xFormat = Excel8
    Case xlExcel12:
        xFile = ".xlsb"
        xFormat = xlExcel12
    End Select
    FilePath = Environ$("temp") & "\"

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    Debug.Print FilePath & FileName & xFile
    Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
    With OutlookMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Type your subject here"
        .Body = "Type your email body here."
        .Attachments.Add Wb2.FullName
        .Display
'        .Send
    End With
    Wb2.Close
    Kill FilePath & FileName & xFile
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False

End Sub
This comment was minimized by the moderator on the site
Hello Guys,

Could you please help me with a VB code which should expand, Ungroup or Unhide base on if cell is selected with X and Y value
This comment was minimized by the moderator on the site
Hi Santosh,
I don't quite understand what you mean. You may need to attach a screenshot or a sample file to describe the problem you encountered more clearly.
This comment was minimized by the moderator on the site
Hi,
In my excel there is an chart, is there a way that when the button is pressed, the email is generated with the chart included into the body of the email?
Rated 3.5 out of 5
This comment was minimized by the moderator on the site
Hi Jack,
The following VBA code can do you a favor. After clicking the button, a dialog box will pop up, please enter the name of the chart you will include in your email body.
In the code, please change "Sheet1" to the name of the sheet that contains the chart you will send.
Private Sub CommandButton1_Click()
'Updated by Extendoffice 20220826
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = ""
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Hi

I'm trying the initial request to simply have a button to open a new email but it doesn't seem to work.

Wondering if it has something to do with the " 'Updated by Extendoffice 2017/9/14" date.

Please let me know how to update this so I can get the button working :)
This comment was minimized by the moderator on the site
Hi Jonathan Matthias,
This line 'Updated by Extendoffice 2017/9/14" is a remark we give to the VBA code, which has nothing to do with the running of the VBA code.
Please make sure that CommandButton1 in the first line of the code is the same name as your button.
The name of the button will be displaysed in the Name Box after selecting it. See the screenshot below.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/email_button.png
This comment was minimized by the moderator on the site
Hi everyone,

On the lines of the email I'm trying right 4 lines of text and even adding "vbNewLine" is returning some errors. Also I'm trying to reference a column on the email subject and isn't showing anything. I really would appreciate any help.

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
ActiveWorkbook.Save

xMailBody = "Hi Kaitlyn," & vbNewLine & vbNewLine & _
"Please see the attached NPI form for for you review and approval." & vbNewLine & vbNewLine _
"Many thanks in advance, Liz"

On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Updated NPI Form" & (B5)
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub GroupBox542_Click()
End Sub
This comment was minimized by the moderator on the site
Hi Camila,
The following VBA code can do you a favor. Please give it a try. Thank you.
Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi Kaitlyn," & vbNewLine & _
               "The second line" & vbNewLine & _
              "Please see the attached NPI form for for you review and approval." & vbNewLine & _
              "Many thanks in advance, Liz"
                  On Error Resume Next
    With xOutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Updated NPI Form" & Range("B5")
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
How do I add code so that when the user submits the form via email to prompt them to include their name
This comment was minimized by the moderator on the site
Hi Susy Fong,
I don't quite understand what you mean. Can you explain it more specifically?
This comment was minimized by the moderator on the site
Hi, your tutorial has been very useful but if I wanted to include a range in the mail body instead of a string how would I go about that. Currently replacing the strings by referencing the cells is not working eg. xMailBody = ThisWorkbook.Activeworksheet("sheet1").Range("A2:F40") does not work
This comment was minimized by the moderator on the site
Activeworksheet("sheet1").Range("A2:F40").Value will work
This comment was minimized by the moderator on the site
Hi, perfect. Thank you. Is there any possibility to set also from which mail adress should be the mail sent? (in Outlook, I have two adresses, it automatically set one adress, but I need the second just for this makro) Thanks
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations