如何用VSTO C#实现Outlook收件邮件选中文本提取及自定义按钮功能

1. 提取邮件正文选中文本的核心方法 #

不管邮件是HTML还是纯文本格式，都能通过Outlook对象模型获取选中内容：

• 若邮件在单独窗口打开：用ActiveInspector.WordEditor.Selection.Text获取选中文本（Outlook邮件编辑区基于Word组件）
• 若邮件在阅读窗格：用ActiveExplorer.Selection(1).GetInspector.WordEditor.Selection.Text获取

2. 隐藏存储收集到的信息 #

用Outlook内置的UserProperties绑定当前邮件存储信息，这是隐藏属性，不会在邮件界面显示：

• 定义两个自定义属性CollectedEmail和CollectedErrorReason，分别存储邮箱地址和错误说明

3. 自定义功能区按钮完整实现（VBA+Ribbon XML） #

步骤1：添加Ribbon XML自定义按钮 #

打开Outlook VBA编辑器（按Alt+F11），插入模块和Ribbon XML文件（无此选项需先安装Office自定义工具），Ribbon XML代码如下：

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <tabs>
      <tab idMso="TabMail">
        <group id="CustomGroup" label="信息收集">
          <button id="BtnSaveEmail" label="保存邮箱地址" size="normal" onAction="BtnSaveEmail_Click"/>
          <button id="BtnSaveError" label="保存错误说明" size="normal" onAction="BtnSaveError_Click"/>
          <button id="BtnProcessInfo" label="处理收集信息" size="normal" onAction="BtnProcessInfo_Click"/>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

步骤2：编写VBA处理代码 #

在模块中添加以下代码：

' 保存选中的邮箱地址到邮件隐藏属性
Sub BtnSaveEmail_Click(control As IRibbonControl)
    Dim objMail As MailItem
    Dim selectedText As String
    Dim userProp As UserProperty
    
    Set objMail = GetCurrentMailItem()
    If objMail Is Nothing Then Exit Sub
    
    selectedText = Trim(GetSelectedText(objMail))
    If selectedText = "" Then
        MsgBox "请先选中邮箱地址再点击按钮！", vbExclamation
        Exit Sub
    End If
    
    Set userProp = objMail.UserProperties("CollectedEmail")
    If userProp Is Nothing Then
        Set userProp = objMail.UserProperties.Add("CollectedEmail", olText)
    End If
    userProp.Value = selectedText
    objMail.Save
    MsgBox "邮箱地址已保存！", vbInformation
End Sub

' 保存选中的错误/原因说明到邮件隐藏属性
Sub BtnSaveError_Click(control As IRibbonControl)
    Dim objMail As MailItem
    Dim selectedText As String
    Dim userProp As UserProperty
    
    Set objMail = GetCurrentMailItem()
    If objMail Is Nothing Then Exit Sub
    
    selectedText = Trim(GetSelectedText(objMail))
    If selectedText = "" Then
        MsgBox "请先选中错误/原因说明再点击按钮！", vbExclamation
        Exit Sub
    End If
    
    Set userProp = objMail.UserProperties("CollectedErrorReason")
    If userProp Is Nothing Then
        Set userProp = objMail.UserProperties.Add("CollectedErrorReason", olText)
    End If
    userProp.Value = selectedText
    objMail.Save
    MsgBox "错误说明已保存！", vbInformation
End Sub

' 处理收集到的信息
Sub BtnProcessInfo_Click(control As IRibbonControl)
    Dim objMail As MailItem
    Dim emailAddr As String
    Dim errorReason As String
    Dim userProp As UserProperty
    
    Set objMail = GetCurrentMailItem()
    If objMail Is Nothing Then Exit Sub
    
    ' 读取存储的信息
    Set userProp = objMail.UserProperties("CollectedEmail")
    If Not userProp Is Nothing Then emailAddr = userProp.Value
    Set userProp = objMail.UserProperties("CollectedErrorReason")
    If Not userProp Is Nothing Then errorReason = userProp.Value
    
    ' 验证信息完整性
    If emailAddr = "" Or errorReason = "" Then
        MsgBox "请先保存邮箱地址和错误说明！", vbExclamation
        Exit Sub
    End If
    
    ' 此处替换为你的自定义处理逻辑（如写入Excel、发送通知等）
    MsgBox "收集到的信息：" & vbCrLf & _
           "邮箱地址：" & emailAddr & vbCrLf & _
           "错误说明：" & errorReason, vbInformation
    
    ' 可选：处理完成后清空存储属性
    ' objMail.UserProperties("CollectedEmail").Delete
    ' objMail.UserProperties("CollectedErrorReason").Delete
    ' objMail.Save
End Sub

' 辅助函数：获取当前活动邮件项
Function GetCurrentMailItem() As MailItem
    Dim objItem As Object
    On Error Resume Next
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set objItem = Application.ActiveInspector.CurrentItem
    Else
        Set objItem = Application.ActiveExplorer.Selection.Item(1)
    End If
    If TypeName(objItem) = "MailItem" Then
        Set GetCurrentMailItem = objItem
    Else
        Set GetCurrentMailItem = Nothing
        MsgBox "请选中或打开一封邮件！", vbExclamation
    End If
End Function

' 辅助函数：获取邮件正文选中文本
Function GetSelectedText(objMail As MailItem) As String
    Dim objInspector As Inspector
    Dim objDocument As Object
    Dim objSelection As Object
    
    Set objInspector = objMail.GetInspector
    Set objDocument = objInspector.WordEditor
    Set objSelection = objDocument.Application.Selection
    
    GetSelectedText = objSelection.Text
End Function

4. 测试验证 #

1. 保存VBA代码后重启Outlook，邮件选项卡会出现「信息收集」组及三个自定义按钮
2. 打开或选中目标收件邮件，高亮邮箱地址点击「保存邮箱地址」，再高亮错误说明点击「保存错误说明」
3. 点击「处理收集信息」即可读取存储内容并执行自定义逻辑

内容的提问来源于stack exchange，提问作者Patrick