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!