Capturing Message Body

[Michael]

The following code snippet works OK (from a macro) when a message is fully
open.

OpenApp = Application.Name

If InStr(1, OpenApp, "Outlook") > 0 Then
Set myitem = Application.ActiveInspector
If TypeName(myitem) = "Nothing" Then
MsgBox "Not an Email message", 0, "Leaving without Saving"
Set myitem = Nothing
Exit Sub
End If
OrigDocName = "NoOriginal"
OrigPath = "NoPath"
End If

Re_Enter_DocName:
' new outlook message
If OrigDocName = "" Or InStr(1, OpenApp, "Outlook") > 0 Then
OrigDocName = InputBox("Enter the Name - Extension (.xxx) will be
Deduced", "Null Entry or Cancel will Exit", "")
If Nz(OrigDocName, "") = "" Or InStr(1, OrigDocName, ".") <> 0 Then
Set myitem = Nothing
Exit Sub
End If
End If

Set myMail = myitem.CurrentItem
strID = myMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olmail = olNS.GetItemFromID(strID)

If olmail.BodyFormat = 3 Then
OrigDocName = OrigDocName & ".doc"
ElseIf olmail.BodyFormat = 2 Then
OrigDocName = OrigDocName & ".htm"
ElseIf olmail.BodyFormat = 1 Then
OrigDocName = OrigDocName & ".txt"
Else
OrigDocName = OrigDocName & ".rtf"
End If

However if the message is open as a reading "pane" - right or bottom,
it has no "inspector" open and my code makes it leave. If I remove this
check, the program "dies" when it starts executing further Outlook
statements.

I want the code to work not only when the message is fully open, but from a
pane - or
even from just the single line reference.

Can this be done?

TIA
Michael