Note: The other languages of the website are Google-translated. Back to English

How to insert Outlook signature when sending email in Excel?

Supposing you want to send an email directly in Excel, how can you add the default Outlook signature in the email? This article provides two methods to help you adding Outlook signature when sending email in Excel.

Insert signature into Outlook email when sending by Excel VBA
Easily insert Outlook signature when sending email in Excel with an amazing tool

More tutorials for mailing in Excel...


Insert signature into Outlook email when sending by Excel VBA

For example, there is a list of email addresses in a worksheet, to send emails to all these addresses in Excel and add the default Outlook signature in the emails. Please apply the below VBA code to achieve it.

1. Open the worksheet contains the email address list you want to email to, and then press the Alt + F11 keys.

2. In the opening Microsoft Visual Basic for Applications window, click Insert > Module, and then copy the below VBA 2 into the Module code window.

3. Now you need to replace the .Body line in VBA 2 with the code in VBA 1. After that, move the line .Display under the line With xMailOut.

VBA 1: Template of sending emails with Outlook default signature in Excel

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

VBA 2: Send email to email addresses specified in cells in Excel

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

The following screenshot can help you easily find the differences after changing the VBA code.

4. Press the F5 key to run the code. Then a Kutools for Excel select box pops up, please select the email addresses you will sent emails to, and then click OK.

Then emails are created. You can see Outlook default signature is added at the end of the email body.

Tips:

  • 1. You can change the email body in VBA code 1 based on your needs.
  • 2. After running the code, if an error dialog box pops up warning that the User-defined type not defined, please close this dialog, and then go to click Tools > References in the Microsoft Visual Basic for Applications window. In the opening References – VBAProject window, check the Microsoft Outlook Object Library box and click OK. And then run the code again.

Easily insert Outlook signature when sending email in Excel with an amazing tool

If you are a newbie in VBA, here highly recommend the Send Emails utility of Kutools for Excel for you. With this feature, you can easily send emails based on certain fields in Excel and add Outlook signature to them. Please do as follows.

Before applying Kutools for Excel, please download and install it firstly.

Firstly, you need to create a mailing list with different fields you will send emails based on.

You can manually create a mailing list as you need or apply the Create Mailing List feature to quickly get it done.

1. Click Kutools Plus > Create Mailing List.

2. In the Create Mailing List dialog box, specify the fields you need, choose where to output the list, and then click the OK button.

3. Now a mailing list sample is created. As it is a sample list, you need to change the fields to certain needed content. (multiple rows are allowed)

4. After that, select the whole list (include headers), click Kutools Plus > Send Emails.

5. In the Send Emails dialog box:

  • 5.1) Items in the selected mailing list are placed in corresponding fields automatically;
  • 5.2) Finish the email body;
  • 5.3) Check both the Send email via Outlook and Use Outlook’s signature settings boxes;
  • 5.4) Click the Send button. See screenshot:

Now emails are sent. And the default Outlook signature is added at the end of the email body.

  If you want to have a free trial ( 30-day) of this utility, please click to download it, and then go to apply the operation according above steps.


Related articles:

Send email to email addresses specified in cells in Excel
Supposing you have a list of email addresses, and you want to send email message to these email addresses in bulk directly in Excel. How to achieve it? This article will show you methods of sending email to multiple email addresses which specified in cells in Excel.

Send email with copying and pasting a specified range into email body in Excel
In many cases, a specified range of contents in Excel worksheet may be useful in your email communication. In this article, we will introduce a method of sending an email with specified range pasting into email body directly in Excel.

Send email with multiple attachments attached in Excel
This article is talking about sending an email through Outlook with multiple attachments attached in Excel.

Send email if due date has been met in Excel
For example, if the due date in column C is less than or equal to 7 days (current date is 2017/9/13), then send an email reminder to the specified recipient in column A with specified content in column B. How to achieve it? This article will provide a VBA method to deal with it in details.

Automatically send email based on cell value in Excel
Supposing you want to send an email through Outlook to a certain recipient based on a specified cell value in Excel. For example, when the value of cell D7 in a worksheet is greater than 200, then an email is created automatically. This article introduces a VBA method for you to quickly solve this issue.

More tutorials for mailing in Excel...


The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
officetab bottom
Comments (27)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
thank u very much, u save my life with this template :D
This comment was minimized by the moderator on the site
Dear Favio,
Glad to help.
This comment was minimized by the moderator on the site
doesnt work with attachments in Office 2016
This comment was minimized by the moderator on the site
Dear Chris,
The below VBA code can help you. After running the code, please select cells containing email addresses you will send emails to, and then select the files you need to attach in the email as attachments when the second dialog box pops up. And the default Outlook signature will be displayed in the email body as well. Thank you for your comment.

Sub SendEmailToAddressInCells()
Dim xRg As Range
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
If xFileDlg.Show = -1 Then
For Each xRgEach In xRg
xRgVal = xRgEach.Value
If xRgVal Like "?*@?*.?*" Then
Set xMailOut = xOutApp.CreateItem(olMailItem)
With xMailOut
.Display
.To = xRgVal
.Subject = "Test"
.HTMLBody = "This is a test email sending in Excel" & "
" & .HTMLBody
For Each xFileDlgItem In xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
Next xFileDlgItem
'.Send
End With
End If
Next
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End If
End Sub
This comment was minimized by the moderator on the site
i am trying to add the outlook signature titled "default" but cannot seem that it works.
can you please help? I believe that my "xMailout" logic is wrong. this is my suspected faulty area.

Private Sub CommandButton1_Click()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Greetings:" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "Email Title Here - " & Range("Cell#").value
.Body = xMailBody
. Attachments.Add ActiveWorkbook.FullName
Set xMailOut = xOutApp.CreateItem(olMailItem)
With xMailOut
.Display
End With
ActiveWorkbook.Save
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Good day,
You script has been modified, please have try. Thank you.

Private Sub CommandButton1_Click()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Greetings:" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "Email Title Here - " & Range("Cell#").Value
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
Set xMailOut = xOutApp.CreateItem(olMailItem)
With xMailOut
.Display
End With
End With
ActiveWorkbook.Save
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
how to add signature if the macro is used by multiple user.
for eg my macro will be run by 3 other persons as well. So how can the macro use the signature of the user who is running the macro.
thanks in advance
This comment was minimized by the moderator on the site
Good Day,
The VBA code can automatically recognize the default signature in the Outlook of the sender, and send email with his own signature through Outlook.
This comment was minimized by the moderator on the site
If my body text is linked to pull from excel fields, the use of & .HTMLBody at the end of the string erases all of the body text and just leaves the signature.
This comment was minimized by the moderator on the site
I'm having trouble running this on excel 2016. I get a "Compile Error: User Defined Type Not Defined" message. Please help!
This comment was minimized by the moderator on the site
Superb!!!!
This comment was minimized by the moderator on the site
Thanks a lot...
This comment was minimized by the moderator on the site
Hi, I would need help with my macro, I need to insert the Outlook signature under the table, could you help me with that?

Private Sub CommandButton1_Click()


Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

With newEmail
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.display

Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor

Sheet5.Range("B6:I7").Copy

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.display
Set pageEditor = Nothing
Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing

End Sub
This comment was minimized by the moderator on the site
Hi Bara,
Sorry can't help you with that. Thanks for your comment.
This comment was minimized by the moderator on the site
Dear,
Can someone help me with my VBA,
I need the signature in the email created:
This comment was minimized by the moderator on the site
Thanks to you, I can add signature now but then it removes spaces between paragraph of text. Please Can you Help me ?


Sub helloworld()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim Path As String
Path = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Range("C4:C6")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = cell.Value
.Subject = Cells(cell.Row, "D").Value
.HTMLBody = "Dear " & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Warm Greetings" _
& vbNewLine & vbNewLine & _
"We, JK Overseas, would like to take an opportunity and introduce our company J K Overseas, which is involved in the salt business for the last 3 years. We are currently strong in domestic and expanding overseas. We are the supplier of Edible Salt, Water Softening Salt, De-icing Salt, Industrial Salt" & "." _
& vbNewLine & vbNewLine & _
"We have a tie-up with large scale manufacturers in India and procure from them quality Salt and exports. So, we are looking for a reliable expert importer as well as distributor agent to make a long-term Business with mutual benefit" & "." _
& vbNewLine & vbNewLine & _
"Please contact us with your requirement or for any other inquiries you may have. We provide reliable logistics and on-time delivery. We are confident that our prices being most competitive will match your expectations" & "." _
& vbNewLine & vbNewLine & _
.HTMLBody

'.Send
End With
Next cell
End Sub
This comment was minimized by the moderator on the site
I am trying to integrate this code into the current format I currently have whereby I am able to automate emails within excel based on a set range of values. Any help in regard to where to add the 'signature' code within what I currently have would be much appreciated.

Public Sub CheckAndSendMail()

'Updated by Extendoffice 2018/11/22

Dim xRgDate As Range

Dim xRgSend As Range

Dim xRgText As Range

Dim xRgDone As Range

Dim xOutApp As Object

Dim xMailItem As Object

Dim xLastRow As Long

Dim vbCrLf As String

Dim xMailBody As String

Dim xRgDateVal As String

Dim xRgSendVal As String

Dim xMailSubject As String

Dim I As Long

On Error Resume Next

'Please specify the due date range

xStrRang = "D2:D110"

Set xRgDate = Range(xStrRang)

'Please specify the recipients email address range

xStrRang = "C2:C110"

Set xRgSend = Range(xStrRang)

xStrRang = "A2:A110"

Set xRgName = Range(xStrRang)

'Specify the range with reminded content in your email

xStrRang = "Z2:Z110"

Set xRgText = Range(xStrRang)

xLastRow = xRgDate.Rows.Count

Set xRgDate = xRgDate(1)

Set xRgSend = xRgSend(1)

Set xRgName = xRgName(1)

Set xRgText = xRgText(1)

Set xOutApp = CreateObject("Outlook.Application")

For I = 1 To xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Value

If xRgDateVal <> "" Then

If CDate(xRgDateVal) - Date <= 30 And CDate(xRgDateVal) - Date > 0 Then

xRgSendVal = xRgSend.Offset(I - 1).Value

xMailSubject = " JBC Service Agreement Expiring On The " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "Dear " & xRgName.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & " " & xRgText.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & ""

Set xMailItem = xOutApp.CreateItem(0)

With xMailItem

.Subject = xMailSubject

.To = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Display

'.Send

End With

Set xMailItem = Nothing

End If

End If

Next

Set xOutApp = Nothing

End Sub
This comment was minimized by the moderator on the site
It's really helpful code
I need to change text format from right to left In the xOutMsg line
help please .
This comment was minimized by the moderator on the site
I'm trying to send individual sheets from excel to different emails, but it will only attach the workbook itself.  Also, need to be able to add my signature line in.  Any help?Sub AST_Email_From_Excel()

Dim emailApplication As Object
Dim emailItem As Object

Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

' Now we build the email.

emailItem.to = Range("e2").Value

emailItem.CC = Range("g2").Value

emailItem.Subject = "Unreturned Techquidation Equipment"

emailItem.Body = "See the attached spreadsheet for unreturned items in your area"

'Attach current Workbook
emailItem.Attachments.Add ActiveWorkbook.FullName

'Attach any file from your computer.
'emailItem.Attachments.Add ("C:\...)"

'Send the email
'emailItem.send

'Display the email so the user can change it as desired before sending
emailItem.Display

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub
This comment was minimized by the moderator on the site
Hi Chris,The code you provided has been modified. The Outlook signature can now be inserted into the message body. Please give it a try. Thank you.<div data-tag="code">Sub AST_Email_From_Excel()
'Updated by Extendoffice 20220211
Dim emailApplication As Object
Dim emailItem As Object
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

' Now we build the email.
emailItem.Display 'Display the email so the user can change it as desired before sending
emailItem.to = Range("e2").Value
emailItem.CC = Range("g2").Value
emailItem.Subject = "Unreturned Techquidation Equipment"
emailItem.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & emailItem.HTMLBody

'Attach current Workbook
emailItem.Attachments.Add ActiveWorkbook.FullName

Set emailItem = Nothing
Set emailApplication = Nothing

End Sub
This comment was minimized by the moderator on the site
Hi Crystal,Thank you for getting it to add the signature, doesn't appear to like the HTMLBody section though.When I run the macro, it debugs on emailItem.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & emailItem.HTMLBodyand doesn't complete the rest.  
This comment was minimized by the moderator on the site
Hi,
Which Excel version are you using? The following VBA code also can help. Please give it a try. Thanks for your feedback.<div data-tag="code">Sub SendWorkSheet()
'Update by Extendoffice 20220218
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
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") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Range("e2") & " ; " & Range("g2")
With OutlookMail
.Display
.To = Range("e2")
.CC = Range("g2")
.BCC = ""
.Subject = "Unreturned Techquidation Equipment"
.HTMLBody = "See the attached spreadsheet for unreturned items in your area" & "<br>" & .HTMLBody
.Attachments.Add Wb2.FullName
'.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Looks to be Excel 2016 and VBA 7.1
This comment was minimized by the moderator on the site
Oi Cristal, a minha macro perde a configuração da assinatura do e-mail, com imagens e formatação original. Como consigo resolver?

Sub Geraremail()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


With janela
ActiveWorkbook.Save
.Display
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
assinatura = .Body
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & Chr(10) & Chr(10) & assinatura
.Attachments.Add Anexo01
End With

End Sub
This comment was minimized by the moderator on the site
Com a mudança abaixo, consegui ajustar. Porém a letra do corpo da mensagem fica em Times New Roman. Gostaria de usar Calibri, como posso alterar o código?

Sub Geraremail()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


With janela
ActiveWorkbook.Save
.Display
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
assinatura = .Body
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
.Attachments.Add Anexo01
End With

End Sub
This comment was minimized by the moderator on the site
Hi Milla,
The following VBA code can help you change the font of email body to Calibri, please give it a try. Thank you.
Before running the code, you need to click Tools > Reference in the Microsoft Visual Basic for Applications window, and then check the Microsoft Word Object Library checkbox in the References - VBAProject dialog box as the screenshot shown below.
[img]I:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
This comment was minimized by the moderator on the site
Hi Milla,
The following VBA code can help you change the font of email body to Calibri, please give it a try. Thank you.
Before running the code, you need to click Tools > Reference in the Microsoft Visual Basic for Applications window, and then check the Microsoft Word Object Library checkbox in the References - VBAProject dialog box as the attached file shown below.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
There are no comments posted here yet
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations