How to copy formatted text from Word document to Rich Text Format email body?-CodePudding

This macro drafts an email in Rich Text Format. (HTML body is not an option for me in this case.)

I need to populate the body of the email with default text and two attachments placed in the middle of the email. (Path1 and Path2).

I find formatting body text with RTF less intuitive than HTML. Copying the body of the email from a dynamic Word document seems like a good solution.

(I did not write the majority of this code, just trying to improve it for this purpose.)

Option Explicit
Function send_mail_rich_text(ByVal send_to As String, ByVal 
    mail_subject As String, ByVal mail_content As Range, ByVal 
    cc_list As String)

    Dim oOlApp As Object    ' Outlook.Application
    Dim oOlMItem As Object  ' Outlook.MailItem
    Dim oWdDoc As Object    ' Word.Document
    
    Dim Path1 As String
    Dim Path2 As String
    
    Path1 = "C:\Users\DegenTrader\Desktop\Wallet Allocations 42069xD.xlxs"
    Path2 = "C:\Users\DegenTrader\Desktop\Hash Rate Info.xlsx"
    
    Err.Clear

    Set oOlApp = CreateObject("Outlook.Application")
    Set oOlMItem = oOlApp.CreateItem(olMailItem)

    ' Range can be copied directly as given as Range via function call
    'mail_content.Copy

    ' On Error Resume Next   ' activate it after debugging
    With oOlMItem
        .To = send_to
        .Subject = mail_subject
        .BodyFormat = 3 ' 3=RichTextFormat

        'Set oWdDoc = .GetInspector.WordEditor

        ' by this you paste below your signature
        ' oWdDoc.Paragraphs(oWdDoc.Paragraphs.Count).Range.Paste

        .Display
    End With

    Application.CutCopyMode = False

    If Err.Number <> 0 Then
        send_mail_rich_text = "error"
    ElseIf oOlMItem.Sent = True Then
        send_mail_rich_text = "sent"
    Else
        send_mail_rich_text = "no error, but not sent"
    End If
End Function

Sub TestSendmailFunction()
    Debug.Print send_mail_rich_text("[email protected]", "HODL- To the Moon!", ActiveSheet.Range("B2:C3"), "[email protected]")
End Sub

CodePudding user response：

There is no need to set the message body format to the RTF if you don't deal with RTF in the code. So, you can remove the following line of code:

.BodyFormat = 3 ' 3=RichTextFormat

To add attachments you can use the Attachments.Add method which creates a new attachment in the Attachments collection. For example:

Sub AddAttachment() 
 Dim myItem As Outlook.MailItem 
 Dim myAttachments As Outlook.Attachments 
 
 Set myItem = Application.CreateItem(olMailItem) 
 Set myAttachments = myItem.Attachments 
 myAttachments.Add "C:\Test.doc", _ 
 olByValue, 1, "Test" 
 myItem.Display 
End Sub

Finally, to send the email you need to replace the Display method with the Send one.

CodePudding user response：

When calling MailItem.Attachments.Add, specify the attachment position using the Position parameter (parameter number 3). It is a good idea to have \objattph RTF placeholder tag placed at that position.