将富文本导出到 Outlook 并保持格式

问题描述

我在 Access 中有一个按钮，可以打开 Outlook，创建约会.

Private Sub addAppointEstimate_Click()Dim objOutlook 作为对象Dim objOutLookApp 作为对象Dim strSubject 作为字符串将 strBody 调暗为字符串strSubject = Forms!frmMain.LastName '要添加更多内容strBody = DLookup("EstimateText", "tblEstimateItems", "EstimateID = 78") '&Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateID)Set objOutlook = CreateObject("Outlook.Application")设置 objOutLookApp = objOutlook.CreateItem(1)使用 objOutLookApp.subject = strSubject.RTFBody = StrConv(strBody, vbFromUnicode).展示结束于结束子

问题是我想在正文中插入富文本，但格式不正确，因为它显示了所有 HTML 标签，例如:

示例text

有没有一种方法可以将富文本发送或转换为 Outlook 可以识别的格式?(也许使用剪贴板)

似乎很多人都有 Excel 的解决方案，但我很难让他们在 Access 中工作:

• 带标签的 HTML 文本在 Excel 单元格中格式化文本

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

解决方案

我想出了一个解决方案.我刚刚复制并粘贴了整个 sub，但我保证答案就在那里.我还强调了重要的部分.

我在家用机器上工作，但不在客户端上工作.所以我不能使用它，但如果你能改进它，请告诉我.

Private Sub addAppointmentEst_Click()Dim objOutlook 作为对象Dim objOutLookApp 作为对象Dim strSubject 作为字符串将 strBody 调暗为字符串出错时转到约会EstErrorIf Not IsNull(DLookup("EstimateID", "tblEstimate", "TransactionID = " & Me.TransactionID.Value)) 然后DoCmd.OpenForm "frmEditEstimate", , , , , acHidden '<------ 在表单中打开格式化文本Forms!frmEditEstimate.SetFocusForms!frmEditEstimate!frmSubEstimateItems.Form.EstimateText.SetFocusDoCmd.RunCommand acCmdCopy '<------ 复制格式化文本DoCmd.Close acForm, "frmEditEstimate", acSaveNo万一' 如果不是 IsNull(Forms!frmMain.Title.Value) 那么' strSubject = strSubject &Forms!frmMain.Title.Value'        万一如果不是 IsNull(Forms!frmMain.FirstName.Value) 那么strSubject = strSubject &表单！frmMain.FirstName.Value万一如果不是 IsNull(Forms!frmMain.LastName.Value) 那么strSubject = strSubject &" " &表单！frmMain.LastName.Value万一如果不是 IsNull(Forms!frmMain.Organisation.Value) 那么strSubject = strSubject &" (" & Forms!frmMain.Organisation.Value & ")"万一如果不是 IsNull(Forms!frmMain!frmSubTransaction.Form.Property.Value) 然后strSubject = strSubject &"- " &Forms!frmMain!frmSubTransaction.Form.Property.Value万一Set objOutlook = CreateObject("Outlook.Application")设置 objOutLookApp = objOutlook.CreateItem(1)使用 objOutLookApp.subject = strSubject.展示结束于If Not IsNull(DLookup("EstimateID", "tblEstimate", "TransactionID = " & Me.TransactionID.Value)) 然后设置 objectOutlookBody = objOutlook.ActiveInspector.WordEditorobjOutLookApp.Body = vbCrLf &估计 ID:" &Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateID.Value &_vbCrLf &"预计日期:" &Forms!frmMain!frmSubTransaction!frmSubEstimate.Form.EstimateDate.ValueobjectOutlookBody.Application.Selection.Paste '<----- PASTE TEXT INTO APPOINTMENTForms!frmMain.EmptyValue.Value = " " '<----- 空剪贴板表单！frmMain.EmptyValue.SetFocusDoCmd.RunCommand acCmdCopy万一退出子约会EstError:消息框_提示:="在 Outlook 中创建约会失败，附有估计值", _按钮:=vbOKOnly + vbExclamation, _标题:=错误"结束子

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:

• HTML Text with tags to formatted text in an Excel cell

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

解决方案

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

这篇关于将富文本导出到 Outlook 并保持格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！