' Функция добавляет текст в ячейку, формата "Текстовый" или "Общий"(содержащий хотя бы одну букву),
' содержащую данные, не изменяя формат содержимого текста. Текст добавляется в начало.
' Функция возвращает:
'   True - если добавление прошло успешно,
'   False - если произошла ошибка при добавлении.
' Данные в ячейку НЕ добавятся (результат будет False) если:
'   - ячейка в которую добавляются данные пуста,
'   - добавляемый текст - пустой
'   - формат ячейки в котороую производится вставка НЕ "Текстовый" или "Общий"(содержащий хотя бы одну букву)
'   - произошла ошибка поиска тега Data
' Известные проблемы:
' 1. В процессе вставки подменяются некоторые цвета, например:
'       если в ячейке был фрагмент выделенный зеленым цветом #00B050,
'       то после добавления цвет меняется на #008080.
' 2. Если целевая ячейка входила в диапазон(ы) условного форматирования, то после вставки
' целевая ячейка исключается из диапазона(ов) правил условного форматирования.
' Например, если для Cell(1, 1), на листе было правило условного форматирования =$B1>10, для диапазона =$1:$1000,
' то после вставки правило остается прежним, а диапазон изменяется на =$2:$1000;$B$1:$XFD$1, (ячейка 1.1 исключается).
Function AddTextInCell(TargetCell As Range, sAddString As String) As Boolean
    Dim sXML As String
    Dim p As Long
    Dim pData As Long
    
    AddTextInCell = False
    
    ' Если нечего добавлять - выходим
    If sAddString = "" Then Exit Function
    
    ' Получаем содержимое целевой ячейки в формате XML
    sXML = TargetCell.Value(xlRangeValueXMLSpreadsheet)
    
    ' Заменяем переносы строк пробелами, для того чтобы корректно отработал поиск нужной подстроки
    sXML = Application.Trim(Replace$(Replace$(Replace$(sXML, vbCrLf, " "), vbLf, " "), vbCr, " "))
  
    ' Определяем позицию в тексте XML с которой начинается тэг данных
    p = InStr(sXML, "Data")
    ' Если тег есть
    If p Then
        ' Ищем позицию окончание тэга Data, т.е. закрывающую часть ">"
        pData = InStr(p, sXML, ">")
        If pData Then
            ' Проверяем что формат ячейки Текстовый или Общий (в ячейке есть буква):
            '    внутри тега Data ищем слово String
            If InStr(Mid(sXML, p, pData - p), "String") > 0 Then
                ' добавляем нужные нам данные в xml, для этого:
                ' берем левую часть исходного XML до данных в ячейке + добавляем нужный нам текст
                ' + добавляем правую часть исходного XML начиная с данных содержащихся в ячейке.
                sXML = Left(sXML, pData) & sAddString & Mid(sXML, pData + 1)
                ' записываем получившийся XML в ячейку
                TargetCell.Value(xlRangeValueXMLSpreadsheet) = sXML
                ' Возвращаем True
                AddTextInCell = True
            End If
        End If
    End If
End Function ' AddTextInCell(TargetCell As Range, sAddString As String) As Boolean

Sub AddTextInCell()
    ' Получаем содержимое ячейки в формате XML
    sXml = Cells(1, 1).Value(xlRangeValueXMLSpreadsheet)
    
    ' Насколько я понял, заменяем переносы строк пробелами, для того чтобы корректно отработал поиск нужной подстроки
    sXml = Application.Trim(Replace$(Replace$(Replace$(sXml, vbCrLf, " "), vbLf, " "), vbCr, " "))
    
    ' Формируем строку для поиска, сразу после данного текста в XML идут данные содержащиеся в ячейке
    s = "Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">"
    
    ' Определяем позицию в тексте XML с которой начинаются данные ячейки =
    ' позиция начиная с которой нашли строку поиска "s" + длина строки поиска
    p = InStr(sXml, s) + Len(s)
    
    ' добавляем нужные нам данные в xml, для этого:
    ' берем левую часть исходного XML до данных в ячейке + добавляем нужный нам текст (здесь добавлено еще форматирование текста - выделение черным цветом)
    ' + добавляем правую часть исходного XML начиная с данных содержащихся в ячейке.
    sXml = Left(sXml, p - 1) & "<Font html:Color=""#000000"">4. Добавляемый текст
</Font>" & Mid(sXml, p, 32768)
    
    ' записываем получившийся XML в ячейку
    Cells(1, 1).Value(xlRangeValueXMLSpreadsheet) = sXml
End Sub

html:Color="#00B050">ttt</Font>

html:Color="#008080">ttt</Font>

Cells(1, 1).FormulaR1C1 = "4. Обычный текст" & Chr(10) & Cells(1, 1).FormulaR1C1 

ActiveCell.Characters(0, 0).Insert "Дополнительная строка" & Chr(10)

Sub insertText()
 sXml = Cells(1, 1).Value(xlRangeValueXMLSpreadsheet)
 sXml = Application.Trim(Replace$(Replace$(Replace$(sXml, vbCrLf, " "), vbLf, " "), vbCr, " "))
 s = "Type=""String"" xmlns=""http://www.w3.org/TR/REC-html40"">"
 p = InStr(sXml, s) + Len(s)
 sXml = Left(sXml, p - 1) & "<Font html:Color=""#000000"">4. Обычный текст
</Font>" & Mid(sXml, p, 32768)
 Cells(1, 1).Value(xlRangeValueXMLSpreadsheet) = sXml
End Sub

For Each oMail In oFolder.Items

Sub SendSaved()
    Dim oOutApp As Outlook.Application
    Dim oNamespace As Outlook.Namespace
    Dim oFolder As Outlook.MAPIFolder
    Dim oMail As Outlook.MailItem
    Dim i As Long
    
    Set oOutApp = GetObject(, "Outlook.Application")
    Set oNamespace = oOutApp.GetNamespace("MAPI")
    Set oFolder = oNamespace.GetDefaultFolder(olFolderDrafts)
    
    For i = 1 To oFolder.Items.Count
        Set oMail = oFolder.Items.Item(i)
         oMail.Send
        Set oMail = Nothing
    Next

    Set oFolder = Nothing
    Set oNamespace = Nothing
    Set oOutApp = Nothing
End Sub