none
Get handle on current outlook messaage RRS feed

  • Question

  • I am very new at VBA for outlook (2010) and I'm trying to capture text from a body of a email message.
    Problem is I cannot access the current email message object.

    Goal is: Email Comes in.. I open it to view the body of the message, from there I need to get data from the email itself.
    I figure I could use a macro on the toolbar. 

    How do I start for the code? What is required for initializations? How to work from the currently opened email...

    Once I can get a handle of the email body field , I can do the logic afterwards. - parse the data from $body and save to a file and email to a specific account..

    All examples on the web assume you want to look through your inbox and loop through, etc..
    But I am unable to find anything to work with a currently opened email.

    I don't even know what to declare or set for this scenario.
    Any guidance would be very appreciated as I don't know any thing about VBA.

    Wednesday, August 2, 2017 3:39 PM

Answers

  • Maybe

    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection

    Dim strBody As String

    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.CurrentItem

    strBody = myOlSel.Body

    Otherwise, try:


        Dim oMailItem As MailItem
        Dim oInspector As Inspector
        Dim oDoc As Object
        Dim oWrdApp As Object
        Dim oSelection As Object
        Dim strBody As String
        
        Set oInspector = Application.ActiveInspector
        Set oMailItem = oInspector.CurrentItem

        If oInspector.IsWordMail Then
             Set oDoc = oInspector.WordEditor
            Set oWrdApp = oDoc.Application
            Set oSelection = oWrdApp.Selection
            oSelection.WholeStory
            strBoldy = oSelection
            Set oSelection = Nothing
            Set oWrdApp = Nothing
            Set oDoc = Nothing
        Else
            Select Case oMailItem.BodyFormat
                Case olFormatPlain, olFormatRichText, olFormatUnspecified
                    strBody = oMailItem.Body
                Case olFormatHTML
                    strBody = oMailItem.HTMLBody
            End Select
        End If

        MsgBox strBody

    • Marked as answer by bflagg Friday, August 11, 2017 6:50 PM
    Wednesday, August 2, 2017 7:55 PM
  • I have covered the extraction of data from Outlook messages in some depth in this forum and consolidated that information at

    Seehttp://www.gmayor.com/extract_data_from_email.htm orhttp://www.gmayor.com/extract_email_data_addin.htm

    Basically to access the body of the current message you could use

    Dim oMailItem As MailItem
    Dim oInspector As Inspector
    Dim oDoc As Object
    Dim oRng As Object
    Dim strBody As String
        On Error Resume Next
        Set oMailItem = ActiveExplorer.Selection.Item(1)
        Set oInspector = oMailItem.GetInspector
        Set oDoc = oInspector.WordEditor
        Set oRng = oDoc.Range
        'do something with the range orng
        'e.g.
        strBody = oRng.Text
        MsgBox strBody
    lbl_Exit:
        Set oRng = Nothing
        Set oDoc = Nothing
        Set oInspector = Nothing
        Exit Sub

     
     

    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by bflagg Friday, August 11, 2017 6:50 PM
    Thursday, August 3, 2017 3:22 AM

All replies

  • Something like

    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection

    Dim strBody As String

    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    strBody = myOlSel.Body

    Wednesday, August 2, 2017 6:00 PM
  • Errors out on :
    strBody = myOlSel.Body

    "Object doesn't support property or method"

    Other methods off of myOlSel. doesn't seem to apply.

    strBody = myOlSel.Item(1) 
    returns "Microsoft Store"

    What am I missing?

    Thank you for your time.

    Wednesday, August 2, 2017 7:26 PM
  • Maybe

    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection

    Dim strBody As String

    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.CurrentItem

    strBody = myOlSel.Body

    Otherwise, try:


        Dim oMailItem As MailItem
        Dim oInspector As Inspector
        Dim oDoc As Object
        Dim oWrdApp As Object
        Dim oSelection As Object
        Dim strBody As String
        
        Set oInspector = Application.ActiveInspector
        Set oMailItem = oInspector.CurrentItem

        If oInspector.IsWordMail Then
             Set oDoc = oInspector.WordEditor
            Set oWrdApp = oDoc.Application
            Set oSelection = oWrdApp.Selection
            oSelection.WholeStory
            strBoldy = oSelection
            Set oSelection = Nothing
            Set oWrdApp = Nothing
            Set oDoc = Nothing
        Else
            Select Case oMailItem.BodyFormat
                Case olFormatPlain, olFormatRichText, olFormatUnspecified
                    strBody = oMailItem.Body
                Case olFormatHTML
                    strBody = oMailItem.HTMLBody
            End Select
        End If

        MsgBox strBody

    • Marked as answer by bflagg Friday, August 11, 2017 6:50 PM
    Wednesday, August 2, 2017 7:55 PM
  • I have covered the extraction of data from Outlook messages in some depth in this forum and consolidated that information at

    Seehttp://www.gmayor.com/extract_data_from_email.htm orhttp://www.gmayor.com/extract_email_data_addin.htm

    Basically to access the body of the current message you could use

    Dim oMailItem As MailItem
    Dim oInspector As Inspector
    Dim oDoc As Object
    Dim oRng As Object
    Dim strBody As String
        On Error Resume Next
        Set oMailItem = ActiveExplorer.Selection.Item(1)
        Set oInspector = oMailItem.GetInspector
        Set oDoc = oInspector.WordEditor
        Set oRng = oDoc.Range
        'do something with the range orng
        'e.g.
        strBody = oRng.Text
        MsgBox strBody
    lbl_Exit:
        Set oRng = Nothing
        Set oDoc = Nothing
        Set oInspector = Nothing
        Exit Sub

     
     

    Graham Mayor - Word MVP
    www.gmayor.com

    • Marked as answer by bflagg Friday, August 11, 2017 6:50 PM
    Thursday, August 3, 2017 3:22 AM
  •        

    Thank you both....I"ve been out with some surgery and couldn't respond right away....
    It was enlightening.  I was able to find this and expand it for my purposes....now to just export to csv, but I can do that.. Just updating with what I found.   Thank you both.

     Dim objOL As Outlook.Application
        Dim objItem As Object

        Dim tName As String
        Dim tTitle As String
        Dim tDept As String
        Dim tSuper As String
        Dim tLocal As String

        Dim fName As String
        Dim lName As String
        Dim Title As String
        Dim deptNo As String
        Dim DeptName As String
        Dim Manager As String
        Dim City As String
        Dim State As String

        On Error Resume Next
        Set objOL = Application
        Set objItem = objOL.ActiveExplorer.Selection(1)
        If Not objItem Is Nothing Then
            tName = Trim(ParseTextLinePair(objItem.Body, "New Hire:"))
            tTitle = ParseTextLinePair(objItem.Body, "Title:")
            tDept = ParseTextLinePair(objItem.Body, "Dept:")
            tSuper = ParseTextLinePair(objItem.Body, "Reports To:")
            tLocal = ParseTextLinePair(objItem.Body, "Location:")
           
            If tName <> "" Then
                fName = Trim(Left(tName, InStr(tName, " ")))
                lName = Trim(Right(tName, Len(tName) - InStr(tName, " ")))
                Title = tTitle
                deptNo = Trim(Left(tDept, InStr(tDept, " ")))
                DeptName = getDeptName(deptNo)    //goes to a function to return department name from it's code number
                Manager = Left(tSuper, InStr(tSuper, ",") - 1)
                City = Left(tLocal, InStr(tLocal, ",") - 1)
                State = Right(tLocal, Len(tLocal) - InStr(tLocal, " "))
                   >>Export to csv here...         
            Else
                MsgBox "Could not extract Name from message."
            End If
        End If
       
        Set objOL = Nothing
        Set objItem = Nothing
       
    End Sub

    Function ParseTextLinePair(strSource As String, strLabel As String)
        Dim intLocLabel As Integer
        Dim intLocCRLF As Integer
        Dim intLenLabel As Integer
        Dim strText As String

        intLocLabel = InStr(strSource, strLabel)
        intLenLabel = Len(strLabel)

            If intLocLabel > 0 Then
            intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
            If intLocCRLF > 0 Then
                intLocLabel = intLocLabel + intLenLabel
                strText = Mid(strSource, intLocLabel, intLocCRLF - intLocLabel)
            Else
                intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
            End If
        End If

        ParseTextLinePair = Trim(strText)
    End Function

               



    • Edited by bflagg Friday, August 11, 2017 6:55 PM
    Friday, August 11, 2017 6:53 PM