Import text from email body (Outlook)

[sharky12345]

I've seen lots of information on this around the internet but nothing that really achieves what I need.

I want to be able to import data from a specific email message, (Outlook), but do it from Excel, not from within Outlook.

I'm not really fussed whether or not the message has to be saved first somewhere then imported or imported direct from Outlook, but what's important is that the user can be prompted to choose which message to import and, if the message has to be saved somewhere first, it is deleted afterwards.

Can anyone give me a start please?

 

[sharky12345]

*bump*

 

[sharky12345]

*bump*

 

[sharky12345]

*bump*

 

[John_w]

You haven't said how the user should specify which email should be imported (e.g. by subject, received date, Outlook folder, etc.).

This code just displays the email body text of the first currently selected email and should give you a start.

Public Sub GetCurrentEmailBody()

    Dim outApp As Outlook.Application
    Dim outExplorer As Outlook.Explorer
    Dim currentItem As Object
    Dim outEmail As Outlook.MailItem
    
    Set outApp = New Outlook.Application
    Set outExplorer = outApp.ActiveExplorer
    
    Set currentItem = outExplorer.Selection.Item(1)
    If currentItem.Class = olMail Then
        Set outEmail = currentItem
        MsgBox outEmail.Body
    End If
    
 End Sub

The code requires the Outlook object library; select this in Tools - References in the VBA editor.

 

[sharky12345]

Thanks John - the user should be able to navigate to the correct message which will always be in their Inbox.

 

[sharky12345]

I've got this working really well now, but what would make it perfect is some sort of prompt for the user to actually select the email rather than the one that is already selected. Also, if Outlook is not open, can it be opened automatically or at least present a message telling the user to do so?

 

[John_w]

I don't know of a way to allow the user to browse Outlook and select an email.

Here is v2 of the code which opens Outlook if it is not running.

Public Sub GetCurrentEmailBody2()
    
    Dim outApp As Outlook.Application
    Dim outExplorer As Outlook.Explorer
    Dim currentItem As Object
    Dim outEmail As Outlook.MailItem
    
    Set outApp = OpenOutlook
    
    Do
        Set outExplorer = outApp.ActiveExplorer
        DoEvents
    Loop While outExplorer Is Nothing
    
    Set currentItem = outExplorer.Selection.Item(1)
    If currentItem.Class = olMail Then
        Set outEmail = currentItem
        MsgBox outEmail.Body
    End If
    
End Sub

Private Function OpenOutlook() As Outlook.Application
    
    'See if Outlook is running and if not open it. Returns the Outlook Application object
    
    Dim Outlook As Object
    
    Set Outlook = Nothing
    On Error Resume Next
    Set Outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If Outlook Is Nothing Then CreateObject("wscript.shell").Run "outlook.exe", 2, False
    Set OpenOutlook = New Outlook.Application  'CreateObject("Outlook.Application")

End Function

 

[sharky12345]

Thanks John - it's certainly progress!