Экспорт форматированного текста в Outlook и сохранение форматирования

Question

У меня в Access есть кнопка, которая открывает Outlook, создавая встречу.

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

Проблема в том, что я хочу вставить форматированный текст в текст, но он не форматируется правильно, поскольку вместо этого отображаются все теги HTML, например:

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

Есть ли способ отправить или преобразовать форматированный текст в Outlook в формате, который он распознает? (Возможно с использованием буфера обмена)

Кажется, у многих есть решение для Excel, но я изо всех сил пытаюсь заставить их работать в Access:

• HTML-текст с тегами для форматированного текста в ячейке Excel

• http://dailydoseofexcel.com/archives/2005/02/23/html-in-cells-ii/

Answer 1

Я придумал решение. Я только что скопировал и вставил весь саб, но ответ там, я обещаю. Я также выделил важные моменты.

Я работаю на своей домашней машине, но не на клиентах. Поэтому я не могу использовать его, но если вы можете улучшить его, дайте мне знать.

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

Answer 2

Передать строку в формате RTF в тело письма электронной почты outlook очень просто:

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

Секрет не в том, чтобы использовать ".RTFBody", а просто в ".Body" и передавать ему байтовый массив, как в коде выше. Мне потребовалось некоторое время, чтобы понять это. Благодаря Microsoft у нас всегда будет что выяснить.

Answer 3

Вы можете использовать небольшие дополнительные затраты для создания сообщения с отформатированным содержимым HTMLBody, а затем скопировать содержимое в элемент "Встреча".

Начните с создания сообщения и встречи и заполнения их по желанию. Поместите основной текст в сообщение, пропустите основной момент встречи.

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

Затем используйте свойство GetInspector для взаимодействия с телом каждого элемента через редактор Word и скопируйте форматированный текст таким образом.

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

Этот код протестирован и работает в Access 2013.

Answer 4

Вы устанавливаете свойство Body в виде простого текста. Установите для свойства HTMLBody правильно отформатированную строку HTML.

Answer 5

Как и в предыдущем ответе, эта строка является ключевой, она копирует текст, гиперссылки, изображения и т. Д. Без изменения содержимого буфера обмена:

wdDoc_Appt.Range.FormattedText = wdDoc_Msg.Range.FormattedText