Exporting rich text to outlook and keep formatting

Question

I have a button in Access that opens Outlook, creating an appointment.

Private Sub addAppointEstimate_Click()
    Dim objOutlook As Object
    Dim objOutLookApp As Object
    Dim strSubject As String
    Dim strBody As String

    strSubject = Forms!frmMain.LastName 'more stuff to add
    strBody = DLookup("EstimateText", "tblEstimateItems", "EstimateID = 78") '& Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateID)

    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutLookApp = objOutlook.CreateItem(1)
    With objOutLookApp
        .subject = strSubject
        .RTFBody = StrConv(strBody, vbFromUnicode)
        .Display
    End With

End Sub

The problem is that I want to insert Rich text into the Body but it doesn't format correctly, as it shows all the HTML tags instead e.g:

<div><strong>example </strong><font color=red>text</font></div>

Is there a way I can send or convert the rich text to Outlook in a format it will recognise? (Maybe using the clipboard)

It seems many people have solution for Excel, but I am struggling to get them to work in Access:

Is strBody really an RTF formatted string or HTML? In the latter case, simply set the HTMLBody property. — Dmitry Streblechenko, Sep 05 '15 at 22:48

score 4 · Answer 1 · edited Nov 18 '18 at 06:05

To pass RTF formatted string to outlook email body is simple as following

Function RTF2Outlook(strRTF as String) as boolean
    Dim myOlApp, myOlItem
    Dim arrFiles() As String, arrDesc() As String, i As Long

    Set myOlApp = CreateObject("Outlook.Application")
    Set myOlItem = myOlApp.CreateItem(olMailItem)

    With myOlItem
       .BodyFormat = olFormatRichText
       .Body = StrConv(strRTF, vbFromUnicode) 'Convert RTF string to byte array
    End With
    Set myOlApp = Nothing
    Set myOlItem = Nothing
End Function

The secret is not to use ".RTFBody" but just ".Body" and pass to it byte array as in the code above. It took me awhile to figure it out. Thanks to Microsoft we always will have something to figure out.

Thanks for the observation to use .Body and not .RTFBody. I have been working this for 2 days, finally it seems to work. — Marichyasana, Mar 25 '16 at 22:07

score 2 · Answer 2 · answered Jun 16 '14 at 17:40

You can use a little extra overhead to create a message with the formatted HTMLBody content, then copy the content to an Appointment item.

Start by creating a message and an appointment and populating them as desired. Put the body text in the message, skip the body in the appointment for now.

Dim objOutlook As Object
Dim objMyMsgItem As Object
Dim objMyApptItem As Object
Dim strSubject As String

strSubject = "Some text" 'Forms!frmMain.LastName 'more stuff to add

Set objOutlook = CreateObject("Outlook.Application")
Set objMyMsgItem = objOutlook.CreateItem(0) 'Message Item
With objMyMsgItem
    .HTMLBody = "<div><strong>example </strong><font color=red>text</font></div>"
            'DLookup("EstimateText", "tblEstimateItems", "EstimateID = 78")
    .Display
End With

Set objMyApptItem = objOutlook.CreateItem(1) 'Appointment Item
With objMyApptItem
    .Subject = strSubject
    .Display
End With

Then use the GetInspector property to interact with the body of each item via a Word editor, and copy the formatted text that way.

Dim MyMsgInspector As Object
Dim wdDoc_Msg As Object
Set MyMsgInspector = objMyMsgItem.GetInspector
Set wdDoc_Msg = MyMsgInspector.WordEditor

Dim MyApptInspector As Object
Dim wdDoc_Appt As Object
Set MyApptInspector = objMyApptItem.GetInspector
Set wdDoc_Appt = MyApptInspector.WordEditor

wdDoc_Appt.Range.FormattedText = wdDoc_Msg.Range.FormattedText

This code is tested and works in Access 2013.

I might be wrong, but I swear that last GetInspector block of code doesn't do anything? — Magnus, Jun 16 '14 at 19:02
Try adding a reference to the Microsoft Word 14.0 Object Library (in the Visual Basic Editor, click References under the Tools menu, scroll down and check the appropriate box). — AjimOthy, Jun 16 '14 at 21:24
Hacky but worked beautifully thanks. I'm using a JavaScript version: var apptIns = appointment.GetInspector(); var msgIns = msg.GetInspector(); var apptDoc = apptIns.WordEditor; var msgDoc = msgIns.WordEditor; apptDoc.Range().FormattedText = msgDoc.Range().FormattedText; — WheretheresaWill, Jan 29 '16 at 03:07

score 0 · Answer 3 · answered Jun 16 '14 at 13:46

0

You are setting the plain text Body property. Set the HTMLBody property to a properly formatted HTML string.

answered Jun 16 '14 at 13:46

Dmitry Streblechenko

62,942
4
53
78

The object doesnt support .HTMLBody property apparently. And I dont think I can change .BodyFormat of an appointment either. – Magnus Jun 16 '14 at 14:03
Outlook appointments, task and contacts indeed do not support the HTMLBody property, it is only exposed by the MailItem objects. You can either set the RtfBody property(array of byte) to a properly formatted RTF data. If using Redemption is an option, it exposes the HTMLBody property on the RDOAppointmentItem, RDOContactItem and RDOTaskItem objects - at run time Redemption dynamically converts the specified HTML to RTF. – Dmitry Streblechenko Jun 16 '14 at 14:36
Ok I have tried setting the RTFBody property to my text. I think I converted it into a Byte array correctly (See updated code above). But I get the error message 'RTFBody' of object "_Appointment" failed. Any ideas? – Magnus Jun 16 '14 at 15:26
Nor, StrConv converts one string top another. you need a byte assay (as in Dim SomeVar(100) etc,). Plus it needs to be the real RTF text - open an existing RTF file in Notepad. – Dmitry Streblechenko Jun 16 '14 at 17:26
I am working on a solution which involves coping the formatted text into the clipboard, then pasting it into appointment body. I know I should probably post this as a new question, but is it possible to paste into the body using VBA in access? – Magnus Jun 20 '14 at 17:49

score 0 · Accepted Answer · answered Jul 03 '14 at 15:43

I came up with a solution. I have just copied and pasted the entire sub, but the answer is in there I promise. I have also highlighted the important bits.

I works on my home machine, but not on the clients. So I cant use it, but if you can improve on it let me know.

Private Sub addAppointmentEst_Click()


    Dim objOutlook As Object
    Dim objOutLookApp As Object
    Dim strSubject As String
    Dim strBody As String

    On Error GoTo appointmentEstError

    If Not IsNull(DLookup("EstimateID", "tblEstimate", "TransactionID = " & Me.TransactionID.Value)) Then
        DoCmd.OpenForm "frmEditEstimate", , , , , acHidden '<------ OPEN FORMATTED TEXT IN A FORM
        Forms!frmEditEstimate.SetFocus
        Forms!frmEditEstimate!frmSubEstimateItems.Form.EstimateText.SetFocus
        DoCmd.RunCommand acCmdCopy '<------ COPY FORMATTED TEXT
        DoCmd.Close acForm, "frmEditEstimate", acSaveNo
    End If

'        If Not IsNull(Forms!frmMain.Title.Value) Then
'            strSubject = strSubject & Forms!frmMain.Title.Value
'        End If
     If Not IsNull(Forms!frmMain.FirstName.Value) Then
         strSubject = strSubject & Forms!frmMain.FirstName.Value
    End If
    If Not IsNull(Forms!frmMain.LastName.Value) Then
        strSubject = strSubject & " " & Forms!frmMain.LastName.Value
    End If
    If Not IsNull(Forms!frmMain.Organisation.Value) Then
        strSubject = strSubject & " (" & Forms!frmMain.Organisation.Value & ")"
    End If
    If Not IsNull(Forms!frmMain!frmSubTransaction.Form.Property.Value) Then
        strSubject = strSubject & " - " & Forms!frmMain!frmSubTransaction.Form.Property.Value
    End If

    Set objOutlook = CreateObject("Outlook.Application")
    Set objOutLookApp = objOutlook.CreateItem(1)

     With objOutLookApp
         .subject = strSubject
         .Display
     End With

    If Not IsNull(DLookup("EstimateID", "tblEstimate", "TransactionID = " & Me.TransactionID.Value)) Then
        Set objectOutlookBody = objOutlook.ActiveInspector.WordEditor
        objOutLookApp.Body = vbCrLf & "Estimate ID: " & Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateID.Value & _
                            vbCrLf & "Estimate Date: " & Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateDate.Value
        objectOutlookBody.Application.Selection.Paste '<----- PASTE TEXT INTO APPOINTMENT

        Forms!frmMain.EmptyValue.Value = " " '<----- EMPTY CLIPBOARD
        Forms!frmMain.EmptyValue.SetFocus
        DoCmd.RunCommand acCmdCopy
    End If

Exit Sub

appointmentEstError:
        MsgBox _
        Prompt:="Failed create an appointment in Outlook, with the estimate attached", _
        Buttons:=vbOKOnly + vbExclamation, _
        Title:="Error"
End Sub

score 0 · Answer 5 · answered Mar 08 '15 at 14:51

0

As in previous answer, this line is the key, it copies text, hyperlinks, pictures etc. without modifying clipboard content:

wdDoc_Appt.Range.FormattedText = wdDoc_Msg.Range.FormattedText

answered Mar 08 '15 at 14:51

T800

71
1

Exporting rich text to outlook and keep formatting

5 Answers5

Linked