Send Word document as email body

I already explained how to send emails automatically, but didn’t really focus on the content of the email. That is probably biggest problem of this method followers. In this article I’m going to show You how to cope with such issue and send Word document as email body.

The easiest way to have the content formatted properly is to copy text from Word and paste that to the created email. You cannot pass the content as string variable, because You will loose all the formatting.

Also there are other possibilities like adding HTML tags into the content, but this solution is good, when You have only 1 text. Not changeable, static, You know. And if it’s really long it would take a lot of time for tagging…

Anyway, back to the main topic, Word content to email body!

First of all, You need to copy the Word file content into the clipboard. To do that You need to create Word object and set the document – the equivalent of an Excel worksheet.

Set wd = CreateObject("Word.Application")
Set doc = wd.documents.Open("Word file path")

Then You can copy the content of the document and store it in clipboard.

doc.Content.Copy

Now comes the standard part of sending the email with a small modification. Instead of .Body You need to go to the WordEditor in your e-message.

Set editor = .GetInspector.WordEditor

After that just paste the text stored in clipboard by pasting that into the content of the editor object.

editor.Content.Paste

To this moment everything is easy and clear.

There goes the tricky part

Unfortunately using .Send method the content of the email body is empty. It appears that copy-pasting method is working only for .Display email method.

But nobody said that You can’t combine those 2 methods together.

.Display
.Send

It is causing a small flicker – just before sending, the email is popping up for a split second, but this is the only way to make it work.

Code

Option Explicit

Sub WordDocAsBody()

 Dim OutApp As Object, OutMail As Object
 Dim wd As Object, doc As Object, editor As Object

 Set wd = CreateObject("Word.Application")
 Set doc = wd.documents.Open("Word file path")
 doc.Content.Copy

 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)

 With OutMail
     .To = "email address"
     .Subject = "subject"
     Set editor = .GetInspector.WordEditor
     editor.Content.Paste
     .Display
     .Send
 End With

 doc.Close 0
 Set OutMail = Nothing
 Set wd = Nothing
 Set OutApp = Nothing

 MsgBox "Done"

End Sub

That was the easiest way to have formatted text in the email body, the same way as in Word document. Although this has a small flicker, but I think we can consider this as the fastest and most comfortable way to send complex message using Outlook.

Author: Tomasz Płociński

I'm very advanced in VBA, Excel, also easily linking VBA with other Office applications (e.g. PowerPoint) and external applications (e.g. SAP). I take part also in RPA processes (WebQuery, DataCache, IBM Access Client Solutions) where I can also use my SQL basic skillset. I'm trying now to widen my knowledge into TypeScript/JavaScript direction.

43 thoughts on “Send Word document as email body”

  1. On ‘Set editor = .GetInspector.WordEditor’ I get “Run-time error ‘287’: Application-defined or object-defined error”.

    I have Office, Word, Excel and Outlook 16.0 Object Library references selected.

    Any suggestions?

    1. Is Word the default email editor?

      From the Inspector.WordEditor doc:
      The WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord . The returned WordDocument object provides access to most of the Word object model…

  2. Thanks, quite simple and useful code!

    Any idea why it adds 1 line spacing when copied to the Outlook email? Looks good and no spacing on the Word document, but it appears with 1 empty row between each line of the text on the Outlook message.

    1. Hello Nikola!
      Have You checked your Word doc for these marks?
      I mean are You sure they are not 100% there, but only misformat whole text in new email?
      You can try to replace every double new lines for 1 empty line if there is still a problem.

  3. I work from two different PCs and keep the Word file I’d like to reference on Onedrive. Is there a way that I can use a URL to reference the Word doc?

    1. Have You tried to just use the Word doc from Onedrive the same way as it is stored on PC?

  4. If you use SharePoint you can host the file there to be accessed from multiple locations/pcs. Thats what I did for my team at work. I have an excel file that lets me choose which word template I want to send and it will open the document copy the content and paste it into a new Outlook email.

  5. I am having a slight issue. Sometimes it will not copy the word content into the email and I have to close the email and run the macro again. 9 times out of 10 it works the second time. Other than that this macro works so well!!

    Do you think there is a way to prevent this from happening?

    1. Make sure that You close every file (Word) You opened.
      Maybe try to give it a 1second break?
      Or loop until macro copy the content of Word.
      Probably it is the downside of opening those files from Sharepoint.

      1. It happens whether or not its on SharePoint.

        – I tried the 1 second break
        – I have made sure the files are closed

        Could you explain the loop until macro copies the content of Word?

        Still seems to “forgets” to copy to email randomly.

        1. You could try Do Until the email body contains the content of Word (any “specified word from Word content in email body) 🙂

          1. Thanks for the advice. Do you mind sharing what you mean?

            Maybe an example code? Here is what I am doing. Where do I put the loops?

            ——————————————————————-

            Set WordDoc = WordApp.Documents.Open(filename:=DocLoc, ReadOnly:=False) ‘Open Template

            WordDoc.Content.Copy

            Set OutApp = CreateObject(“Outlook.Application”) ‘Create Outlook Application
            Set OutMail = OutApp.CreateItem(0) ‘Create Email
            With OutMail
            .SentOnBehalfOfName = “Do not Send”
            .BCC = “Testing – Do not Send”
            .subject = “Testing 123”
            .Attachments.Add

            Set editor = .GetInspector.WordEditor
            editor.Content.Paste
            Application.CutCopyMode = False ‘Clears the Clipboard

            .Display ‘To send without Displaying change .Display to .Send

            ———————————————————————

            Im not sure if the issue is in the copy from Word or the paste to Outlook… Could be either. I think its the paste form outlook.

          2. Try to loop the part, where You getting the content of Word and trying to paste. Check if the body of email contains any of “gold” phrase of Word content.

  6. Could not get Loop to work.

    But……….

    I did find a work around. Before my email creation code I added an extra step of opening a new email, pasting content then closing email. This basically clears the error every time before it starts.

    ———————————

    Set OutApp = CreateObject(“Outlook.Application”) ‘Create Outlook Application
    OutApp.Visible = False ‘Make the application not visible to the user
    Set OutMail = OutApp.CreateItem(0) ‘Create Email
    With OutMail
    Set EmailTemplate = OutMail.GetInspector.WordEditor
    EmailTemplate.Content.Paste
    End With
    OutMail.Quit
    OutApp.Visible = True ‘Make the application visible to the user

  7. This works perfectly:

    I had the editor select the email signature and delete it, then copy and paste the WordDoc content after that.

    Set editor = OutMail.GetInspector.WordEditor
    Set oBookmark = editor.Bookmarks(“_MailAutoSig”)
    oBookmark.Select
    editor.Windows(1).Selection.Delete
    WordDoc.Content.Copy
    editor.Content.Paste
    Application.CutCopyMode = False ‘Clears the Clipboard

  8. Hi, when I am trying to run this code I am getting an error 5097 at the line Editor.content.paste

    Can you please help me in this.

    1. Hi Erica
      Have You tried to restart your device? Or restart the Word and Outlook application?

  9. Sometimes I am able to run the code, and other times I am not. I continue to get an error at editor.Content.Paste

    Sub Send_Multiple_Emails()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets(“Sheet1”)
    Dim i As Integer

    Dim OA As Object
    Dim msg As Object
    Dim wd As Object, doc As Object, editor As Object

    Set OA = CreateObject(“outlook.application”)
    Set msg = OA.createitem(0)

    Set wd = CreateObject(“Word.Application”)
    Set doc = wd.documents.Open(“C:\Users\60264\Desktop\MyFP&A\Macros\FP & A Macro Message.rtf”)
    doc.Content.Copy

    Dim last_row As Integer
    last_row = Application.WorksheetFunction.CountA(sh.Range(“A:A”))

    For i = 2 To last_row

    msg.To = sh.Range(“A” & i).Value
    msg.cc = sh.Range(“B” & i).Value
    msg.Subject = sh.Range(“C” & i).Value
    msg.attachments.Add sh.Range(“E” & i).Value

    With msg
    Set editor = .GetInspector.WordEditor
    editor.Content.Paste
    .Display
    ‘.Send
    End With

    sh.Range(“F” & i).Value = “Sent”

    Next i

    ‘MsgBox “All e-mails have been sent successfully.”

    End Sub

    1. Hello Amra!
      Try to get this part into Error handling brackets and implement there a loop -> loop until the code paste the Word content without any error

  10. I have the word doc as an object in a sheet called “Email” (Object1) i have tried every way i can imagine to change the path to use that object rather than a different document. where am i going wrong?

    This is what i have

    Sub Mail_ActiveSheet()
    ‘ Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010
    Dim AString As String * 4096
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim strbody8 As String
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim xWs As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    strDate = Format(Date – 1, “dddd dd mmm yyyy”)
    Set wd = CreateObject(“Word.Application”)
    Set doc = wd.documents.Open(Sheets(“Email”).OLEObject(“Object1”))
    doc.Content.Copy

    Set Sourcewb = ActiveWorkbook

    ‘ Next, copy the sheet to a new workbook.
    ‘ You can also use the following line, instead of using the ActiveSheet object,
    ‘ if you know the name of the sheet you want to mail :
    ‘ Sheets(“Sheet5”).Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    ‘ Determine the Excel version, and file extension and format.
    With Destwb
    If Val(Application.Version) < 12 Then
    ' For Excel 2000-2003
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    ' For Excel 2007-2010, exit the subroutine if you answer
    ' NO in the security dialog that is displayed when you copy
    ' a sheet from an .xlsm file with macros disabled.
    If Sourcewb.Name = .Name Then
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    MsgBox "You answered NO in the security dialog."
    Exit Sub
    Else
    Select Case Sourcewb.FileFormat
    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
    Case 52:
    If .HasVBProject Then
    FileExtStr = ".xlsm": FileFormatNum = 52
    Else
    FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    Case 56: FileExtStr = ".xls": FileFormatNum = 56
    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
    End Select
    End If
    End If
    End With

    ' You can use the following statements to change all cells in the
    ' worksheet to values.
    ' With Destwb.Sheets(1).UsedRange
    ' .Cells.Copy
    ' .Cells.PasteSpecial xlPasteValues
    ' .Cells(1).Select
    ' End With
    ' Application.CutCopyMode = False

    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = ActiveSheet.Name & " " & Format(Now, "dd-mm-yy")

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, _
    FileFormat:=FileFormatNum
    On Error Resume Next
    ' Change the mail address and subject in the macro before
    ' running the procedure.
    With OutMail
    .To = ActiveSheet.Name
    .CC = ""
    .BCC = ""
    .Subject = ActiveSheet.Name & " " & Format(Now, "dd-mm-yy") & " " & "- MANDATORY TRAINING"
    Set editor = .GetInspector.WordEditor
    editor.Content.Paste
    .Display

    .Attachments.Add Destwb.FullName
    ' You can add other files by uncommenting the following statement.
    '.Attachments.Add ("C:\test.txt")
    ' In place of the following statement, you can use ".Display" to
    ' display the mail.
    .Display
    End With
    On Error GoTo 0
    .Close SaveChanges:=False
    End With

    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub

    1. First of all, clear code from unnecessary comments, they are not needed here, no help from them – longer code, much more illegible.
      Second of all, what is the question – where is the problem / what is not working / what are You trying to achieve?

      1. So I am emailing an attached copy of the active sheet to a email group (named the same as the sheet for ease). I have the above (i believe it is actually your code from another post) but i have played around with it so much now i have forgotten what is original.
        So the email that goes with the attachment we change every now and then and the staff who do it are not the most tech savy. I built this as the process used to take 3-4 hours of copying each sheet, saving it to teams, sharing to email then importing the names from that sheet and checking email addresses.
        I have added a word doc as an Object to a sheet called “Email”, I want it to copy what is in the object and paste that into the email but when i run this it just errors on

        Set doc = wd.documents.Open(Worksheets(“Email”).OLEObject(“Object1”))

        and i get run-time Error:’438′: Object does not support this property or method

        I have cleared it up, sorry it has been 15 years since i did any VB coding.

        Sub Mail_ActiveSheet()
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
        Dim xWs As Worksheet
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim OutApp As Object
        Dim OutMail As Object
        strDate = Format(Date – 1, “dddd dd mmm yyyy”)
        Set wd = CreateObject(“Word.Application”)
        Set doc = wd.documents.Open(Worksheets(“Email”).OLEObject(“Object1”))
        doc.Content.Copy

        Set Sourcewb = ActiveWorkbook
        ActiveSheet.Copy
        Set Destwb = ActiveWorkbook
        With Destwb
        If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
        Else
        If Sourcewb.Name = .Name Then
        With Application
        .ScreenUpdating = True
        .EnableEvents = True
        End With
        MsgBox "You answered NO in the security dialog."
        Exit Sub
        Else
        Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
        If .HasVBProject Then
        FileExtStr = ".xlsm": FileFormatNum = 52
        Else
        FileExtStr = ".xlsx": FileFormatNum = 51
        End If
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
        End If
        End If
        End With

        TempFilePath = Environ$("temp") & "\"
        TempFileName = ActiveSheet.Name & " " & Format(Now, "dd-mm-yy")

        Set OutApp = CreateObject("Outlook.Application")

        Set OutMail = OutApp.CreateItem(0)

        With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
        FileFormat:=FileFormatNum
        On Error Resume Next

        With OutMail
        .To = ActiveSheet.Name
        .CC = ""
        .BCC = ""
        .Subject = ActiveSheet.Name & " " & Format(Now, "dd-mm-yy") & " " & "- MANDATORY TRAINING"
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        .Display

        .Attachments.Add Destwb.FullName
        .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
        End With

        Kill TempFilePath & TempFileName & FileExtStr

        Set OutMail = Nothing
        Set OutApp = Nothing

        With Application
        .ScreenUpdating = True
        .EnableEvents = True
        End With
        End Sub

        1. Hello
          Do You consider another way of storing the .doc file, other than keeping that inside of the Excel?
          Haven’t yet done or seen such thing. If You must do it like that, try to simulate double click on this object and then set to the Word object already opened one.

  11. If error is coming ‘word has encounter problem’ while pasting data from word document to outlook mail body, this can solved by doing click on outlook app and then any of folder like inbox or sent items. I was also facing same issue

  12. Hi Tomasz,

    Very informative article. Thank you for your effort.

    What I try to achieve is to use the code with the multiple email bodies that are stored in different files.
    In your code file path is declaired. I would like to use file path that is stored in the cell that offsets from another cell.
    Would it be possible to use it with Offset(0,xx) somehow ?

    Not really sure what I am doing as I try to copy and merge different codes from varius websites :/

    Code:

    Sub WordDocAsBody()

    Dim OutApp As Object, OutMail As Object
    Dim wd As Object, doc As Object, editor As Object

    Set wd = CreateObject(“Word.Application”)

    Dim Sciezka As String
    Sciezka = “\\xxx\xx\ankiety\”
    Dim Odbiorcy As Range
    Set Odbiorcy = Range(“A17”, Range(“A17”).End(xlDown))
    Dim R As Range

    For Each R In Odbiorcy
    Set OutApp = CreateObject(“Outlook.Application”)
    Set OutMail = OutApp.CreateItem(0)

    set doc = wd.documents.Open.<—-?
    doc.Content.Copy

    With OutMail
    .SentOnBehalfOfName = "mail@mail.pl"
    .To = R.Offset(0, 2)
    .CC = R.Offset(0, 4)
    .BCC = R.Offset(0, 5)
    .Subject = R.Offset(0, 9)
    Set editor = .GetInspector.WordEditor
    editor.Content.Paste
    .Display
    '.Send
    End With

    doc.Close 0
    Set OutMail = Nothing
    Set wd = Nothing
    Set OutApp = Nothing

    Next R
    End Sub
    '
    '

    Kind regards
    Piotr

    1. Hello
      Would it be possible to use it with Offset(0,xx) somehow ? – Yes, it is possible 🙂
      Set Odbiorcy = Range(“A17”, Range(“A17”).End(xlDown)) – try to be more specified, refer to worksheet
      set doc = wd.documents.Open.<—-? – the file path is needed to have opened specified file
      Just give it a go and then share with us what are the results 🙂

      1. Many thanks for the advice.

        I have not clearly specified what I want to achieve, so this time I will be more specific.

        File with macro contains a list of all recipients I would like to send email to.

        Column A ( from A17 down) contains the username , in B there is language of the survey I would like to send, C stores email address (To:) , D – first name ; E – CC: ; F: BC: ; G – name of the file I would like as attachement ;  J: Subject (different each time) ; K: – .docx file where the body of the email is kept (different depending on the language from column B) .

        I would like to be able to send attachments (preferably multiple) ; to the recipients, where each recipient will receive email as follows:

        In the body: Name ( from column D) + then body from the email specified (file name taken from the column K – file is stored on the network)

        Multiple attachements ( if possible to use more than one attachement)

        Code that I attach below is the closest to what I would like to achieve, but it only works with certain limitations:

        – works only once after rebooting PC ;  if I want to run it a second time, it hangs ( I assume I didnt close the word properly in the code)

        – does not allow me to add first name ( column D) & body from the file ( R.Offset(0, 10))

        -Only one body – hardcoded in the file specified can be attached
        Sub PrzygotujMaile()

        On Error Resume Next
        Dim OutApp As Object
        Dim OutMail As Object
        Dim wd As Object
        Dim doc As Object
        Dim editor As Object
        Dim Odbiorcy As Range
        Dim R As Range

        Set OutApp = CreateObject(“Outlook.Application”)
        Set OutMail = OutApp.CreateItem(0)
        Set wd = CreateObject(“Word.Application”)

        Set Odbiorcy = Worksheets(“ankiety”).Range(“A17”, Worksheets(“ankiety”).Range(“A17”).End(xlDown))

        Dim Sciezka As String
        Sciezka = “\\network_path\folder\”
        For Each R In Odbiorcy
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
        .SentOnBehalfOfName = “mail@mail.pl”
        .To = R.Offset(0, 2)
        .CC = R.Offset(0, 4)
        .BCC = R.Offset(0, 5)
        .Subject = R.Offset(0, 9)
        .Attachments.Add (Sciezka & R.Offset(0, 8))
        Set doc = wd.documents.Open(“\\network_path\folder\Mail_przewodni_pl.docx”) ‘ < — here instead of Mail_przewodni_pl.docx I woulld like to use value from cell R.Offset(0, 11)
        doc.Content.Copy

        Set editor = .GetInspector.WordEditor
        editor.Content.Paste

        .Display

        End With

        doc.Close 1
        Set wd = Nothing
        Next R
        Set OutApp = Nothing
        Set OutMail = Nothing
        'Set wd = Nothing

        End Sub

        Hope this is more clear than previously.

        Again , I appreciate your help.

        Piotr

        1. Hello
          For sure You forgot to Quit the Word application, thats the first thing 🙂
          Easier loop IMO would be something like:
          For i = 17 to lastRow
          and instead of .Offset You could just use .Cells(i, COLUMN_NUMBER).Value COLUMN_NUMBER => specified column for your needs.

          Give me a sign how is it going with that 🙂

        1. Piotr,
          I already gave You my suggestions, see above.
          Have You tried those? 🙂

          1. Hi Tomasz,
            Sorry – getting older, half blind and not any wiser 😉 Didn’t see your reply.
            Code does not work at allo now.
            Not sure what I do wrong, its been almoset 20 years since I did any coding. Like a child in the fog now :/

            Code looks as follows:

            Sub PrzygotujMaile()

            On Error Resume Next
            Dim OutApp As Object
            Dim OutMail As Object
            Dim wd As Object
            Dim doc As Object
            Dim editor As Object
            Dim i As Integer

            Set OutApp = CreateObject(“Outlook.Application”)
            Set OutMail = OutApp.CreateItem(0)
            Set wd = CreateObject(“Word.Application”)

            For i = 17 To lastRow

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
            .SentOnBehalfOfName = “mail@mail.pl”
            .to = .Cells(i, 3).Value
            .CC = .Cells(i, 5).Value
            .BCC = .Cells(i, 6).Value
            .Subject = .Cells(i, 10).Value
            .Attachments.Add .Subject = .Cells(i, 12).Value
            Set doc = wd.documents.Open(“\\network_path\folder\Mail_przewodni_pl.docx”)
            doc.Content.Copy

            Set editor = .GetInspector.WordEditor
            editor.Content.Paste

            .Display

            doc.Close 0
            Set OutMail = Nothing
            Set wd = Nothing
            Set OutApp = Nothing

            End With

            Next i

            End Sub

            What did I mess ut this time?

          2. At the first glance looks fine.
            What is the error?
            Try to move .Display just under the With OutMail
            And of course if You want to send it remember to add .Send 🙂

  13. Genius!
    thank you.
    I now have a rich text ‘word doc embedded in excel’ source -> email machine with a search replace in the middle that can replace bits of the source with parameters calculated by excel, before then emailing the results.
    I can’t praise the clarity of your description highly enough. 🙂

  14. @Tomasz Płociński
    There is no error message.
    Even after moving .Display it just stays blank and does not do anything.

    1. You did not set any value to lastRow, so the loop does not even start
      –> so how You got a blank mail?
      You create an email during loop AND once before for loop starts.

  15. Hi. Sorry for late reply :0

    I was able to complete my file using below code :

    Sub Wysylanie_maili()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim fso As Object
    Dim tempfile As String
    Dim bodytext As String
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim tempdoc As String

    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng1 As Range

    Set OutApp = CreateObject(“Outlook.Application”)
    Set fso = CreateObject(“Scripting.FileSystemObject”)

    Set sh = Sheets(“Generowanie”)
    ‘ On Error Resume Next

    ‘loop
    For Each rng In Range(“A14”, Range(“A” & Rows.Count).End(xlUp))

    ‘create mail
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
    .SentOnBehalfOfName = “mail@mail.pl”
    .To = rng.Offset(0, 2).Value
    .CC = rng.Offset(0, 3).Value
    .BCC = rng.Offset(0, 4).Value
    .Subject = rng.Offset(0, 9).Value

    ‘add files
    If Not IsEmpty(rng.Offset(0, 10).Value) Then
    .Attachments.Add (rng.Offset(0, 10).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 11).Value) Then
    .Attachments.Add (rng.Offset(0, 11).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 12).Value) Then
    .Attachments.Add (rng.Offset(0, 12).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 13).Value) Then
    .Attachments.Add (rng.Offset(0, 13).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 14).Value) Then
    .Attachments.Add (rng.Offset(0, 14).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 15).Value) Then
    .Attachments.Add (rng.Offset(0, 15).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 16).Value) Then
    .Attachments.Add (rng.Offset(0, 16).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 17).Value) Then
    .Attachments.Add (rng.Offset(0, 17).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 18).Value) Then
    .Attachments.Add (rng.Offset(0, 18).Value)
    End If

    If Not IsEmpty(rng.Offset(0, 19).Value) Then
    .Attachments.Add (rng.Offset(0, 19).Value)
    End If

    ‘open word doc
    Set wdApp = CreateObject(“Word.Application”)
    tempdoc = rng.Offset(0, 8).Value
    Set wdDoc = wdApp.Documents.Open(tempdoc, ReadOnly:=True)

    ‘copy and paste to mail
    wdDoc.Content.Copy
    .HTMLBody = “” & .HTMLBody & “”
    .GetInspector().WordEditor.Range.PasteAndFormat wdFormatOriginalFormatting

    With WordEditor.Range.Find
    .Text = “Szanowni,” ‘<-dears
    .Replacement.Text = (rng.Offset(0, 17).Value) '<- replace dears with column value , names
    .Wrap = 1
    .Forward = True
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=2
    End With

    'close word and delete temp file
    wdDoc.Close SaveChanges:=False
    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    DoEvents 'wait for word to close
    If fso.FileExists(tempfile) Then
    On Error Resume Next
    fso.DeleteFile tempfile
    On Error GoTo 0
    End If

    .Display

    End With

    'Move to the next row of data
    Set OutMail = Nothing
    Set rng = rng.Offset(1, 0)

    Next rng

    'Clean up
    Set fso = Nothing
    Set OutApp = Nothing
    End Sub

    I didn't know how to add variable amount of attachements , so I have max 7 of them as I will not need more.

    Hope this comes handy to someone who may need it.

    Much appreciate your answers.
    Kind regards
    Piotr

Leave a Reply

Your email address will not be published. Required fields are marked *