Wow, thank You for that, I will check that for sure!
Nowadays I changed my approach to prepare message template instead of Word template.
Much much easier and faster, maybe I’ll do the article about that 🙂

Instead of using .display to get the paste to show up before doing .send, I think you can close the inspector with the save option and then do the .send, like this:
Set OutlookInspector = msgA.GetInspector
Set weA = msgA.GetInspector.WordEditor
weA.Content.Paste
OutlookInspector.Close 0 ‘ This saves the document
msgA.Send

This removes the flicker. It worked for my tests (and yes, otherwise it needed .display)

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

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.

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 🙂