I have manage to find the following code which works fine except the bold red section will not allow it work on a selected email. (1) will be the last email (2) the second last etc. I have very little experience with macros in Outlook.
Code:
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim WordWasNotRunning As Boolean
Set olItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
olItems.Sort "[Received]", True
[B][COLOR=red]Set olItem = olItems(1)[/COLOR][/B]
WordWasNotRunning = False
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
WordWasNotRunning = True
End If
Set wdDoc = wdApp.Documents.Add
wdDoc.Content.InsertAfter olItem.Body
olItem.UnRead = False
Set olItem = Nothing
Set olItems = Nothing
wdApp.WindowState = wdWindowStateMinimize
wdApp.Visible = True
wdApp.WindowState = wdWindowStateNormal
If WordWasNotRunning = True Then
wdApp.Quit
End If
Set wdDoc = Nothing
Set wdApp = Nothing