Cell text truncated to about 1390 characters - excel

Question

I modified the code here - https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
If the text in the cell is long, it is truncated.
I tried increasing the application time value to 0.20, but that did nothing. It got truncated at the same point.
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
#End If
Sub SendEMail()
Dim xEmail As String
Dim xSubj As String
Dim xMsg As String
Dim xURL As String
Dim i As Integer
Dim k As Double
Dim xCell As Range
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the data range:", "navneesi", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
For i = 1 To xRg.Rows.Count
' Get the email address
xEmail = xRg.Cells(i, 1)
' Message subject
xSubj = "Validation Assignment"
' Compose the message
xMsg = ""
xMsg = xMsg & "Validation Assignment: " & vbCrLf & vbCrLf
xMsg = xMsg & " Order ID: " & xRg.Cells(i, 2).Text & vbCrLf
xMsg = xMsg & " Marketplace ID: " & xRg.Cells(i, 3).Text & vbCrLf
xMsg = xMsg & " Order Day: " & xRg.Cells(i, 4).Text & vbCrLf
xMsg = xMsg & " Seller ID: " & xRg.Cells(i, 5).Text & vbCrLf
xMsg = xMsg & " Product Code: " & xRg.Cells(i, 6).Text & vbCrLf
xMsg = xMsg & " Item Name: " & xRg.Cells(i, 7).Text & vbCrLf
xMsg = xMsg & " Defect Source: " & xRg.Cells(i, 8).Text & vbCrLf
xMsg = xMsg & " Defect Day: " & xRg.Cells(i, 9).Text & vbCrLf
xMsg = xMsg & " Defect Text: " & xRg.Cells(i, 10).Text & vbCrLf
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub

Answer 1

Well, 1390 doesn't seem like any kind of restriction that I have ever heard about. Maybe 255 characters, or a variable-length string of up to approximately 2 billion (2^31) characters, etc. Can you try doing it this way?
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
NOTE:
Make a list in Sheets("Sheet1") with :
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Most relevant URL:
https://www.rondebruin.nl/win/s1/outlook/amail6.htm
Parent URL:
https://www.rondebruin.nl/win/s1/outlook/mail.htm

Answer 2

Found a fix. Instead of usingCells(i, 5).Text use Cells(i, 5).Value.
This makes sure the cell content is sent to outlook as it is instead of converting it to text first which gives rise to issues. (The code in the question was also unable to render chinese text.)
Also, instead of executing a mail to url, I included the object library for outlook and declared the object for outlook application and for mail item. Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem