VBA get selected text from Outlook email body and use in Excel

[jrdnoland]

I have been unable to find code to allow me to get the highlighted (selected) text portion from an outlook email body and assign it to vba string variable so I can use it in excel vba code function.

My process would be something like:
1. Select text string in the format like xxxx-xxx
2. Press button in excel form
3. Get the selected outlook text string
4. Pass the text string to an excel vba function that I already have.

I seem to be able to get the whole email body but not the selected/highlighted text.

sub test

Dim OutApp As Object
Dim OutMail As Object
Dim msgbody As String
Dim Selection As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.ActiveInspector.CurrentItem
msgbody = OutMail.Body

Selection = OutMail.Selection

Debug.Print Selection

Set OutMail = Nothing
Set OutApp = Nothing

end sub

[gmayor]

The following will get the currently selected text from an e-mail message in Outlook. If you are familiar with Word VBA then wdDoc is the message body and can be processed pretty much as a document in Word.

Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim strText As String

    On Error Resume Next
    'Get Outlook if it's running
    Set OutApp = GetObject(, "Outlook.Application")

    'Outlook wasn't running, so cancel
    If Err <> 0 Then
        MsgBox "Outlook is not running so nothing can be selected!"
        GoTo lbl_Exit
    End If
    On Error GoTo 0

    Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
    With OutMail
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        strText = wdDoc.Application.Selection.Range.Text
    End With
    MsgBox strText
lbl_Exit:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Exit Sub
End Sub

[jrdnoland]

The following will get the currently selected text from an e-mail message in Outlook. If you are familiar with Word VBA then wdDoc is the message body and can be processed pretty much as a document in Word.

Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim strText As String

    On Error Resume Next
    'Get Outlook if it's running
    Set OutApp = GetObject(, "Outlook.Application")

    'Outlook wasn't running, so cancel
    If Err <> 0 Then
        MsgBox "Outlook is not running so nothing can be selected!"
        GoTo lbl_Exit
    End If
    On Error GoTo 0

    Set OutMail = OutApp.ActiveExplorer.Selection.Item(1)
    With OutMail
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        strText = wdDoc.Application.Selection.Range.Text
    End With
    MsgBox strText
lbl_Exit:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Exit Sub
End Sub

That was exactly what I needed, worked perfectly. Thank you!