如何从电子邮件主题或身体中复制选定的文本，将其放入链接中并在浏览器中打开

Question

我正在使用Office 365（桌面）的Outlook。

我正在尝试从电子邮件主题或身体中复制选定的文本，并将其放入预定义的网址中，然后在默认浏览器中打开它。

步骤：

1. 打开或选择接收的消息
2. 从主题或身体
3. 运行宏的单词
4. 默认浏览器应打开链接： https://www.dictionary.com/browse/delected word*

下面的代码仅在选定的单词在电子邮件的正文中时仅打开链接。

Sub OPEN_DICT()

Dim msg As Outlook.MailItem
Dim insp As Outlook.Inspector
Dim vURL1
Dim vURL2
Dim fullVID
Dim fullVURL

If Application.ActiveInspector Is Nothing Then
    If Application.ActiveExplorer.Selection.Count = 1 Then
        If Application.ActiveExplorer.Selection.Item(1).Class = olMail Then
            Set msg = Application.ActiveExplorer.Selection.Item(1)
        End If
    Else
        'to many items selected
        MsgBox "Please select one item"
    End If
Else
    Set insp = Application.ActiveInspector
    If insp.CurrentItem.Class = olMail Then
        Set msg = insp.CurrentItem
    End If
End If

If msg Is Nothing Then
    MsgBox "could not determine an item. Try again!"
Else
    If msg.GetInspector.EditorType = olEditorWord Then
        Set hed = msg.GetInspector.WordEditor
        Set appWord = hed.Application
        Set Rng = appWord.Selection
        With Rng
            .Copy
        End With

    End If
End If

If IsNumeric(Rng) Then
    fullVID = Rng
    vURL1 = "https://www.dictionary.com/browse/"
    vURL2 = fullVID
    fullVURL = vURL1 & vURL2

Else
    fullVID = Rng
    vURL1 = "https://www.dictionary.com/browse/"
    vURL2 = fullVID
    fullVURL = vURL1 & vURL2

End If

Dim build
Set build = CreateObject("Shell.Application")
build.ShellExecute "Chrome.exe", fullVURL, "", "", 1

ExitNewItem:
    Exit Sub

Set appWord = Nothing
Set insp = Nothing
Set Rng = Nothing
Set hed = Nothing
Set msg = Nothing

End Sub

如何在链接中打开电子邮件主题中所选的文本？
另外，它不应在Chrome中打开链接，而应在默认浏览器中打开。

Answer 1

Outlook Object模型不会暴露任何可以让您从其任何控件中访问所选文本的任何内容，除了消息主体编辑器（以word.document.document对象）曝光。

最好的选择是使用低级Windows API（Findwindow等）找到主题编辑器或自动化或可访问性API。请参阅，例如，如何获得当前聚焦的文本？或如何将任何应用程序选择的文本输入Windows表单应用程序