Getting HTML formatted text from VBA to the Outlook appointment body

Question

I found out HTML isn't a available out-of-pocket option in the AppointmentItem-Object.

Then i found the following answer with code from the user PGilm here (https://stackoverflow.com/a/34666267/18290219)

Dim oApp As Object
Dim oMail As Object

Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(1)

With oMail
    .Subject = ""
    .Location = ""
    '.Start =
    '.Duration =
    ' .body = " < not formattable text >"
    .display
End With

Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection

Set objItem = oMail ' Application.ActiveInspector.currentItem
Set objInsp = objItem.GetInspector
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection

objSel.PasteAndFormat (wdFormatOriginalFormatting)
'objSel.PasteAndFormat (Word.WdRecoveryType.wdFormatOriginalFormatting)

Set objItem = Nothing
Set objInsp = Nothing
Set objDoc = Nothing
Set objWord = Nothing
Set objSel = Nothing

Set oApp = Nothing
Set oMail = Nothing

I tried to understand his suggestion and adapt it to my problem but I can't figure out one point.. Because of not been a extremely good VBA coder.

My html formated text is stored in a string called "messages".

Im really confused with getting this stuff to the clipboard to paste it into the meeting with his code.

can you give me a advice?

Thanks for your help !!

score 1 · Answer 1 · answered Feb 24 '22 at 01:05

I have converted the starting lines of your question to html (with the help of http://hilite.me/).

If you save your HTML message in a html template (e.g with notepad) you can open it with Excel. (A very basic html template you find here => https://www.w3schools.com/html/html_basic.asp)

Having your formatted text in Excel you can copy it to an AppointmentItem (based on the workaround presented here HTMLBody Workaround For OlAppointment Object?:

Sub MakeApptWithRangeBody()

'!!!  ADD Reference to Microsoft Outlook Library
'
'     e.g.
'---> MENU ---> Tools ---> References
'--->   Microsoft Outlook 16.0 Object Library

Dim olApp As Outlook.Application
Dim olApt As Outlook.AppointmentItem

Const wdPASTERTF As Long = 1

Set olApp = Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)

Dim myTable As ListObject
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$A$15"), , _
    xlNo).Name = "myTable"
Set myTable = ActiveSheet.ListObjects(1)
myTable.TableStyle = None

With olApt
    .Start = Now + 1
    .End = Now + 1.2
    .Subject = "Test Appointment"
    myTable.Range.Copy
    .Display
    .GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
End With
Stop

Set olApt = Nothing
Set olApp = Nothing

End Sub

and your html shows up in the AppointmentItem:

score 1 · Answer 2 · answered Feb 24 '22 at 01:48

If you copy the html formatted text to MS Word you can save the document in RTF format. This rtf document you can either rename to .txt and add the rtf encoding to the vba editor or you read the file with vba.

Based on the proposal here: Exporting rich text to outlook and keep formatting

Sub OpenAppointment()
Dim myRtfString As String

myRtfString = Get_RTF_Text
Call RTF2Outlook(myRtfString)

End Sub


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)
    Set myOlItem = myOlApp.CreateItem(olAppointmentItem)

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

Function Get_RTF_Text()

Dim myString As String

myString = "{\rtf1\adeflang1025\ansi\ansicpg1252\uc1\adeff0\deff0\stshfdbch0\stshfloch0\stshfhich0\stshfbi0\deflang1033\deflangfe2052\themelang1033\themelangfe0\themelangcs0{\fonttbl{\f0\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f2\fbidi \fmodern\fcharset0\fprq1{\*\panose 02070309020205020404}Courier New;}"
myString = myString & "{\f34\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria Math;}{\f36\fbidi \fnil\fcharset134\fprq2{\*\panose 02010600030101010101}DengXian{\*\falt \'b5\'c8\'cf\'df};}"
myString = myString & "{\f44\fbidi \froman\fcharset0\fprq0{\*\panose 020b0609020204030204}Consolas;}{\f45\fbidi \fnil\fcharset134\fprq2{\*\panose 02010600030101010101}@DengXian;}{\flomajor\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}"
myString = myString & "{\fdbmajor\f31501\fbidi \fnil\fcharset134\fprq2{\*\panose 02010600030101010101}DengXian Light{\*\falt \'b5\'c8\'cf\'df Light};}{\fhimajor\f31502\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0302020204030204}Calibri Light;}"
myString = myString & "{\fbimajor\f31503\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\flominor\f31504\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}"
myString = myString & "{\fdbminor\f31505\fbidi \fnil\fcharset134\fprq2{\*\panose 02010600030101010101}DengXian{\*\falt \'b5\'c8\'cf\'df};}{\fhiminor\f31506\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0502020204030204}Calibri;}"
myString = myString & "{\fbiminor\f31507\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f46\fbidi \froman\fcharset238\fprq2 Times New Roman CE;}{\f47\fbidi \froman\fcharset204\fprq2 Times New Roman Cyr;}"
myString = myString & "{\f49\fbidi \froman\fcharset161\fprq2 Times New Roman Greek;}{\f50\fbidi \froman\fcharset162\fprq2 Times New Roman Tur;}{\f51\fbidi \froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f52\fbidi \froman\fcharset178\fprq2 Times New Roman (Arabic);}"
'...
'...
myString = myString & "\ltrch\fcs0 \b\cf20\insrsid8334471 \hich\af2\dbch\af31505\loch\f2 Object}{\rtlch\fcs1 \af2 \ltrch\fcs0 \insrsid8334471 "
myString = myString & "\par }{\rtlch\fcs1 \ab\af2 \ltrch\fcs0 \b\cf19\insrsid8334471 \hich\af2\dbch\af31505\loch\f2 Dim}{\rtlch\fcs1 \af2 \ltrch\fcs0 \insrsid8334471 \hich\af2\dbch\af31505\loch\f2  oMail           }{\rtlch\fcs1 \ab\af2 \ltrch\fcs0 \b\cf1\insrsid8334471 "
myString = myString & "\hich\af2\dbch\af31505\loch\f2 As}{\rtlch\fcs1 \af2 \ltrch\fcs0 \insrsid8334471 \hich\af2\dbch\af31505\loch\f2  }{\rtlch\fcs1 \ab\af2 \ltrch\fcs0 \b\cf20\insrsid8334471 \hich\af2\dbch\af31505\loch\f2 Object}{\rtlch\fcs1 \af2 \ltrch\fcs0 \insrsid8334471 "

Get_RTF_Text = myString

End Function

And the result looks like this:

Getting HTML formatted text from VBA to the Outlook appointment body

2 Answers2