Изменение стиля буфера обмена по электронной почте

Question

У меня есть макрос, который вставляет буфер обмена по электронной почте, но сохраняет исходный формат текста.

Я не могу сделать вставленный текст в нормальном формате или в обычном порядке. Сначала я помещаю текст, затем вставляю буфер обмена, а затем другой текст.

Я хочу, чтобы содержимое буфера обмена имело тот же стиль, что и другие тексты, или просто нормальный.

Set OutMail = OutApp.CreateItem(0) 
With OutMail 
    .To = "" 
    .CC = "" 
    .BCC = "" 
    .Subject = "" 
    Set olInsp = .GetInspector 
    Set wdDoc = olInsp.WordEditor 
    Set oRng = wdDoc.Range 
    oRng.collapse 1 
    .Display 
    OutMail.HTMLBody = textB & OutMail.HTMLBody 
    oRng.Paste 
    OutMail.HTMLBody = textA & OutMail.HTMLBody 

End With 

я попробовал с:

 'oRng.Font.Bold = True ' changes the font but not the style 
    'oRng.Font.Name = "Calibri (Body)" ' changes the font but not the style 
    'oRng.Font.Color = vbRed ' changes the font but not the style 
    'oRng.Style = 1 ' not working 
    'With oRng.ParagraphFormat ' changes the spacing but not the style 
    '.LineSpacingRule = wdLineSpaceAtLeast 
    '.LineSpacing = 10 
    'End With 
    '.BodyFormat = 1 ' not working 

И это код:

Sub aaaaa() 
Dim OutApp As Object 
Dim OutMail As Object 
Dim olInsp As Object 
Dim oRng As Object 
Dim StrBdA As String 
Dim StrBdB As String 
Dim lll As String 
Dim myString As String 
Dim xlApp As Object 
Dim sourceWB As Object 
Dim sourceWS As Object 

StrBdA = "<br> <br>" & "text" _ 
       & "<br> <br>" & "text" _ 
       & "<br> <br>" & "text" _ 
       & "<br>" & "1." & "text</b>" _ 
       & "<br>" & "2." & "text" _ 
       & "<br>" & "3." & "text" & "<br> <br>" 


StrBdB = "<br> <br>" & "text." _ 
       & "<br>" & "text" _ 
       & "<br>" & "text:" _ 
       & "<br>" & "<a link1>link1</a>" _ 
       & "<br>" & "<a link2>link2</a>" _ 
       & "<br> <br>" & "text" & "<br> <br>" 

    On Error Resume Next 
    Set OutApp = GetObject(, "Outlook.Application") 
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application") 
    On Error GoTo 0 

    Set OutMail = OutApp.CreateItem(0) 
    With OutMail 
     OutMail.SentOnBehalfOfName = "" 
     .Importance = olImportanceHigh 
     .To = "" 
     '.CC = "" 
     .BCC = "" 
     .Subject = "" 

     Set olInsp = .GetInspector 
     Set wdDoc = olInsp.WordEditor 
     Set oRng = wdDoc.Range 
     oRng.collapse 1 
     .Display 
     OutMail.HTMLBody = StrBdB & OutMail.HTMLBody 
      oRng.Paste 
      oRng.Font.Bold = True 
     OutMail.HTMLBody = StrBdA & OutMail.HTMLBody 
    End With 
    Set OutMail = Nothing 
    Set OutApp = Nothing 
    Set olInsp = Nothing 
    Set wdDoc = Nothing 
    Set oRng = Nothing 
End Sub 

Answer 1

ли вы пытались что-то, основываясь на этом. Я изначально сделал это для Word, но отлично работает с некоторыми изменениями в своем Outlook 2010

Option Explicit 

Sub SendMailBodyNormal() 

Dim olApp As Object 
Dim olEmail As Object 
Dim olInsp As Object 
Dim wdDoc As Object 
Dim oRng As Object 

    On Error Resume Next 
    Set olApp = GetObject(, "Outlook.Application") 
    If Err <> 0 Then Set olApp = CreateObject("Outlook.Application") 
    On Error GoTo 0 
    Set olEmail = olApp.CreateItem(0) 
    With olEmail 
     .BodyFormat = 2 
     .To = "" 
     .Subject = "Movies Report" 
     Set olInsp = .GetInspector 
     Set wdDoc = olInsp.WordEditor 
     Set oRng = wdDoc.Range(0, 0) 
     oRng.Paste 
     oRng.Style = "Normal" 
     .Display 
    End With 
lbl_Exit: 
    Set olApp = Nothing 
    Set olEmail = Nothing 
    Set olInsp = Nothing 
    Set wdDoc = Nothing 
    Set oRng = Nothing 
    Exit Sub 
End Sub