Using word Template as outlook mail body

Rajan1415 

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:

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 <<Name>> with UserName throughout the document
            With WordDoc.Content.Find
                .Text = "<<Name>>"
                .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: " & Err.Description
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set WordApp = Nothing
End Sub

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.