Using word Template as outlook mail body

Question

Hello,&nbsp;I have created a VBA macro, referring Ms word doc as outlook mail body. If I am using . display to preview mail it's working however when I update code to .send code fails.Please share some solution&nbsp;

nikolinode · Answer

Rajan1415&nbsp;When using a Word document as the body of an Outlook email through VBA, there can be some differences in behavior between using .Display and .Send. The issue you're facing might be related to the timing of sending the email. The .Display method allows you to review and make changes to the email before it is sent, while the .Send method sends the email immediately.Here is a sample code that you can use as a reference:Sub SendEmailWithWordBody()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim WordApp As Object
    Dim WordDoc As Object

' Create a new instance of Outlook
    Set OutlookApp = CreateObject("Outlook.Application")
    ' Create a new email
    Set OutlookMail = OutlookApp.CreateItem(0)

' Create a new instance of Word
    Set WordApp = CreateObject("Word.Application")
    ' Open your Word document
    Set WordDoc = WordApp.Documents.Open("C:\Path\To\Your\Word\Document.docx")

' Copy the content from Word to Outlook
    WordDoc.Content.Copy
    OutlookMail.BodyFormat = 2 ' olFormatHTML
    OutlookMail.HTMLBody = WordApp.Selection.HTML

' Additional email properties (To, Subject, etc.)
    OutlookMail.To = "email address removed for privacy reasons"
    OutlookMail.Subject = "Your Subject"

' Display or Send the email
    ' Uncomment one of the following lines

' OutlookMail.Display ' Use this line for previewing the email before sending

' Uncomment the next line for sending the email
    ' OutlookMail.Send

' Close the Word document and release objects
    WordDoc.Close SaveChanges:=False
    Set WordDoc = Nothing
    Set WordApp = Nothing

' Release Outlook objects
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End SubIn this code:The Word content is copied using WordApp.Selection.HTML and pasted into the HTMLBody of the Outlook email.Make sure to replace "C:\Path\To\Your\Word\Document.docx", "email address removed for privacy reasons", and "Your Subject" with your actual file path, recipient's email address, and subject.The code is set up to either display the email or send it. Comment/uncomment the appropriate line based on your needs.Remember to adjust the file path, recipient email, and subject as needed. Also, be cautious when using .Send, as it will send the email immediately without allowing you to review it.&nbsp;If the issue persists, you may want to check for any error messages that might provide more information on what is going wrong during the .Send operation. Provide additional information about the office version, operating system, storage medium, etc. If possible the existing code. The text, steps and code were created with the help of AI.&nbsp;My answers are voluntary and without guarantee!&nbsp;Hope this will help you.Was the answer useful? Mark as best response and Like it!This will help all forum participants.

rajan1415 · Answer

NikolinoDE&nbsp;Thank you&nbsp; for reverting back, however share code is not working as desired.Kindly review my code and share your insights.&nbsp;Option Explicit

Sub SendMailViaWord()
    On Error GoTo ErrorHandler
    
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim OutAccount As Outlook.Account
    Dim Subject As String
    Dim UserName As String
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordFilePath As String
    Dim LastRow As Long
    Dim i As Long

' Set the Outlook application object
    Set OutApp = CreateObject("Outlook.Application")
    
    ' Set the Word application object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False

' Define the mail subject from cell B1
    Subject = Sheets("Sheet1").Range("B1").Value
    
    ' Define the Word file path from cell B2
    WordFilePath = Sheets("Sheet1").Range("B2").Value

' Find the last row with data in column A (Names)
    LastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row

' Loop through the rows starting from row 6 (assuming headers are in row 4)
    For i = 6 To LastRow
        ' Get the username from the Name column (Column A)
        UserName = Sheets("Sheet1").Cells(i, 1).Value

' Create a new email
        Set OutMail = OutApp.CreateItem(olMailItem)
        
        'Use the ccount based on the number
        Set OutAccount = OutApp.Session.Accounts.Item(Sheets("Sheet1").Range("B3").Value)
              
        ' Add recipients, subject, and body
        With OutMail
            .To = Sheets("Sheet1").Cells(i, 2).Value
            .CC = Sheets("Sheet1").Cells(i, 3).Value
            .BCC = Sheets("Sheet1").Cells(i, 4).Value
            .SendUsingAccount = OutAccount
            .BodyFormat = 2 ' 2 represents olFormatHTML

' Open the Word document
            Set WordDoc = WordApp.Documents.Open(WordFilePath)
            
            ' Find and replace &lt;&lt;Name&gt;&gt; with UserName throughout the document
            With WordDoc.Content.Find
                .Text = "&lt;&lt;Name&gt;&gt;"
                .Replacement.Text = UserName
                .Wrap = wdFindContinue ' Set this to wdFindContinue if you want to continue searching the entire document
                .Execute Replace:=wdReplaceAll ' Use wdReplaceOne if you want to replace only the first occurrence
            End With
            
            ' Copy the modified content from Word document
            WordDoc.Content.Copy
            
            ' Clear existing content in the email body
            .GetInspector.WordEditor.Range.Text = ""
            
            ' Paste the modified content into the email body
            .GetInspector.WordEditor.Range.PasteAndFormat 16 ' 16 represents wdFormatOriginalFormatting
            
            ' Close the Word document
            WordDoc.Close False ' Do not save changes

' Attachments (if any)
            If Not IsEmpty(Sheets("Sheet1").Cells(i, 5).Value) Then
                .Attachments.Add Sheets("Sheet1").Cells(i, 5).Value
            End If

.Subject = Subject  ' Set the email subject
            .Send  ' Send the email
        End With

' Update the status column
        Sheets("Sheet1").Cells(i, 6).Value = "Sent"

' Release the email object
        Set OutMail = Nothing
    Next i

' Release the Outlook application object
    Set OutApp = Nothing
    ' Release the Word application object
    Set WordApp = Nothing

Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " &amp; Err.Description
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set WordApp = Nothing
End Sub&nbsp;&nbsp;&nbsp;

nikolinode · Answer

Rajan1415&nbsp;Your code looks generally well-structured, but it seems there might be an issue with the way you are handling the Outlook references. Specifically, it appears that you are using constants such as olMailItem and wdFindContinue without declaring them explicitly.Here is an updated version of your code with proper declarations and some additional comments:&nbsp;Option Explicit

Sub SendMailViaWord()
    On Error GoTo ErrorHandler
    
    Dim OutApp As Object ' Outlook.Application
    Dim OutMail As Object ' Outlook.MailItem
    Dim OutAccount As Object ' Outlook.Account
    Dim Subject As String
    Dim UserName As String
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordFilePath As String
    Dim LastRow As Long
    Dim i As Long

' Set the Outlook application object
    Set OutApp = CreateObject("Outlook.Application")
    
    ' Set the Word application object
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False

' Define the mail subject from cell B1
    Subject = Sheets("Sheet1").Range("B1").Value
    
    ' Define the Word file path from cell B2
    WordFilePath = Sheets("Sheet1").Range("B2").Value

' Find the last row with data in column A (Names)
    LastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row

' Loop through the rows starting from row 6 (assuming headers are in row 4)
    For i = 6 To LastRow
        ' Get the username from the Name column (Column A)
        UserName = Sheets("Sheet1").Cells(i, 1).Value

' Create a new email
        Set OutMail = OutApp.CreateItem(0) ' 0 represents olMailItem
        
        ' Use the account based on the number
        Set OutAccount = OutApp.Session.Accounts.Item(Sheets("Sheet1").Range("B3").Value)
              
        ' Add recipients, subject, and body
        With OutMail
            .To = Sheets("Sheet1").Cells(i, 2).Value
            .CC = Sheets("Sheet1").Cells(i, 3).Value
            .BCC = Sheets("Sheet1").Cells(i, 4).Value
            .SendUsingAccount = OutAccount
            .BodyFormat = 2 ' 2 represents olFormatHTML

' Open the Word document
            Set WordDoc = WordApp.Documents.Open(WordFilePath)
            
            ' Find and replace &lt;&lt;Name&gt;&gt; with UserName throughout the document
            With WordDoc.Content.Find
                .Text = "&lt;&lt;Name&gt;&gt;"
                .Replacement.Text = UserName
                .Wrap = 1 ' 1 represents wdFindContinue
                .Execute Replace:=2 ' 2 represents wdReplaceAll
            End With
            
            ' Copy the modified content from Word document
            WordDoc.Content.Copy
            
            ' Clear existing content in the email body
            .GetInspector.WordEditor.Range.Text = ""
            
            ' Paste the modified content into the email body
            .GetInspector.WordEditor.Range.PasteAndFormat 16 ' 16 represents wdFormatOriginalFormatting
            
            ' Close the Word document
            WordDoc.Close False ' Do not save changes

' Attachments (if any)
            If Not IsEmpty(Sheets("Sheet1").Cells(i, 5).Value) Then
                .Attachments.Add Sheets("Sheet1").Cells(i, 5).Value
            End If

.Subject = Subject  ' Set the email subject
            .Send  ' Send the email
        End With

' Update the status column
        Sheets("Sheet1").Cells(i, 6).Value = "Sent"

' Release the email object
        Set OutMail = Nothing
    Next i

' Release the Outlook application object
    Set OutApp = Nothing
    ' Release the Word application object
    Set WordApp = Nothing

Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " &amp; Err.Description
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set WordApp = Nothing
End Sub&nbsp;In this version, I've replaced the constants olMailItem and wdFindContinue with their corresponding numeric values, as constants like these might not be recognized without explicit Outlook or Word references.Please make sure to test this code in your environment and adjust it as needed for your specific requirements.If this doesn't help, please provide detailed information as provided in the previous night. Operating system, Excel version, storage medium, photos or file (without sensitive data).

rajan1415 · Answer

NikolinoDEThe new code isn't working properly, and I'm getting an error. I'm using Microsoft 365 Enterprise with Windows 11.The problem is with the ".Send" part of the code. When I change it to ".Display," it opens the preview window just fine. This issue is happening for the first time as I try to use Word as an email template. Everything works fine when I manually include the message in the code.&nbsp;&nbsp;&nbsp;

nikolinode · Answer

Rajan1415&nbsp;hmm…The issue seems to be related to the way the Word document is being used as an email template. When you change the code to ".Display" instead of ".Send," it successfully previews the email because the Word content is directly embedded in the email body. However, when you try to send the email using ".Send," there might be a conflict between the Word document and the Outlook mail item, preventing the proper formatting and sending of the email.To resolve this issue, you can consider the following approaches:Separate Word Document and Email: Instead of embedding the Word document directly into the email, you can save the Word document as an HTML file and then attach it to the email. This will ensure that the Word content is properly formatted and handled by Outlook without any conflicts.Create Custom Template in Outlook: Consider creating a custom email template in Outlook that uses the desired Word document as a starting point. This template can be linked to the Word document and will allow you to dynamically insert personalized content without embedding the entire document.Utilize Third-Party Tools: If you need more advanced functionality or control over the email creation process, you can explore third-party tools that specialize in generating personalized emails from Word templates. These tools often provide more robust integration between Word and Outlook, ensuring seamless email creation and sending.By implementing one of these approaches, you can effectively use Word documents as email templates and avoid the error associated with directly embedding the Word content into the Outlook mail item. The text and steps were edited with the help of AI.As a final thought or attempt without being sure if this will work, Let's try a slightly different approach to handle the Word editor in Outlook. Replace the relevant part of your code with the following:Code:' ...
With OutMail
    ' ... (previous code remains unchanged)

' Paste the modified content into the email body
    .GetInspector.WordEditor.Range.PasteSpecial Link:=False, DataType:=wdPasteHTML, Placement:=wdInLine, DisplayAsIcon:=False

' Close the Word document
    WordDoc.Close False ' Do not save changes

' Attachments (if any)
    If Not IsEmpty(Sheets("Sheet1").Cells(i, 5).Value) Then
        .Attachments.Add Sheets("Sheet1").Cells(i, 5).Value
    End If

.Subject = Subject  ' Set the email subject
    .Send  ' Send the email
End With
' ...In this modification, I replaced the .GetInspector.WordEditor.Range.PasteAndFormat with .GetInspector.WordEditor.Range.PasteSpecial. The PasteSpecial method allows for more control over the pasting process.Also, please make sure that you have the following line at the beginning of your module to ensure that the Word constants are recognized:Code:Const wdPasteHTML As Integer = 10 ' Use the actual value of wdPasteHTML
Const wdInLine As Integer = 0 ' Use the actual value of wdInLine
Const wdFormatOriginalFormatting As Integer = 16 ' Use the actual value of wdFormatOriginalFormattingMake sure that the constant values are correctly set according to the version of Word you are using.After making these changes, try running the code again with the .Send method. If the issue persists, you may consider using the .Display method for now, as it allows you to manually review and send the emails. Alternatively, you might explore other methods like creating the email body directly in VBA without using Word as a template. I'm starting to be unsure whether this can be done with Word document using as a mail template. I can't help any further, I'm at my wits' end.

Forum Discussion

Using word Template as outlook mail body

5 Replies

Resources