none
extract info from email to excel RRS feed

  • Question

  • hi, everyone;

    i am having an issue where i am trying to create a macro, which should take all emails coming in from let say example@sample.com , and look into the text of the body email and give me out only two row of information, into an excel spreadsheet, what i have done already is few steps taking from other furoms and fulfill my needs, but a few things is missing.

    1) i want that the macro should run each time an email comes in from a specific sender, not subject i cant do that because they are not the same each time, (as of now, its only running when i select that specific email and i hit run macro.)

    2) i want that the excel sheet should stay open and the macro should not have to open the page before processing and not close after the process, (as of now,the excel sheet must be closed in order the macro should run proper.)

    how can i do that?

    here is my macro.

    Sub CopyToExcel()
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim olItem As Outlook.MailItem
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim oRng As Range
    Dim i As Long
    Dim rCount As Long
    Dim bXStarted As Boolean
    Const strPath As String = "C:\Users\test\Desktop\Test.xlsx" 'the path of the workbook

    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "No Items selected!", vbCritical, "Error"
        Exit Sub
    End If
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    'Process each selected record
    For Each olItem In Application.ActiveExplorer.Selection
        sText = olItem.Body
        vText = Split(sText, Chr(13))
        'Find the next empty line of the worksheet
        rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
        rCount = rCount + 1

        'Check each line of text in the message body
        For i = UBound(vText) To 0 Step -1
            If InStr(1, vText(i), "Name:") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("A" & rCount) = Trim(vItem(1))
            End If

            If InStr(1, vText(i), "Phone:") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("B" & rCount) = Trim(vItem(1))
            End If


        Next i
        xlWB.Save
    Next olItem
    xlWB.Close SaveChanges:=True
    If bXStarted Then
        xlApp.Quit
    End If
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    Set olItem = Nothing
    End Sub

    Sunday, June 17, 2012 1:08 PM

Answers

  • Hi Auto2,

    Sub CopyToExcell(MyMail As MailItem)

    In this sentence a variable MyMail is a specific mail which you received right now. You can use it in your sub block. Your snippet confused me quite a bit. I think you didn't catch the mean of the KB which I shown you indeed. In Sub CopyToExcell only one thing you need to do: Open Excel and fill the information from MyMail in it.

    Best Regards,

    T.X.


    征诛志异,三让两家王朝
    功同开辟,一桮万古江南

    • Marked as answer by Sol Stein Tuesday, June 26, 2012 9:19 PM
    Tuesday, June 26, 2012 12:56 PM

All replies

  • set up a rule in outlook to run your sub when mail from specific address arrives. As for excel - to attach to running instance change CreateObject to GetObject
    • Proposed as answer by Duptroop Sunday, June 17, 2012 11:07 PM
    • Unproposed as answer by Sol Stein Monday, June 18, 2012 9:16 PM
    Sunday, June 17, 2012 6:34 PM
  • thank you very very much for your time, the rule should do the problem from triggering the macro when a specific massage arrives, and the problem from closing and reopening was solved when i took this down from the macro,

    xlWB.Close SaveChanges:=True
    If bXStarted Then
        xlApp.Quit
    End If

    but here is why its not working;

    when an email arrives it triggers the macro, but in my code it says

    'Process each selected record
    For Each olItem In Application.ActiveExplorer.Selection

    the problem is that this new massage is not in the activeExplorer.selection cause when a new mail arrives the courser is not at the new massage, so what it did, its giving me info from an old massage,

    maybe there is anyone to help me edit this VBA it should get me only the massage what comes now in?

    thank you again DamianD

    really appreciated

    Monday, June 18, 2012 9:46 PM
  • just to be more descriptive;

    basically what i need is, how can i explain in VBA  that when an email triggers a macro, i want to look into "that" email and lookup in "that" body for the text "Name:" and give me the rest of the line?

    the script from above does the trick only if i select that specific massage and i run the macro.

    so how can i make that when an email triggers a macro it should lookup in the email what triggered the macro?

    not what i wrote, "In Application.ActiveExplorer.Selection"

    can anyone give me a code for that?

    Monday, June 18, 2012 10:07 PM
  • when you attach macro to rule for new message arrival, this sub in macro should accept new message as a parameter

    something like

    sub newMailArrived(Object newMail)

    end sub

    Tuesday, June 19, 2012 11:01 AM
  • something like

    sub newMailArrived(Object newMail)

    end sub

    to get clear what you wrote, did you mean i should rewrite the whole macro and start with like dim newmail as object and then For Each newmail In  where?????

    or maybe you meant something else, can you please explain more details?

    thank you very much.

    Wednesday, June 20, 2012 10:37 PM
  • no, macro method that you point as a target of outlook rule (method that should be invoked when rule is triggered) should have signature that accepts object as a parameter which will be the outlook item thast triggered the rule.
    Thursday, June 21, 2012 6:44 AM
  • no, macro method that you point as a target of outlook rule (method that should be invoked when rule is triggered) should have signature that accepts object as a parameter which will be the outlook item thast triggered the rule.
    can you please tell me how to do it? it seems that this will make the trick, but i cant come up how to make it, can you please provide me the steps? thank you again.
    Thursday, June 21, 2012 11:32 PM
  • ok, i am having some idea, but i don't know how to create it maybe someone can help me with the codes,

    i am going to create a rule which will push in all emails coming in from my selected address which needs to be processed into a folder named "extract"

    when the macro is triggered i am going to locate it to look into folder "extract" and look for all massages there and process it, after each email is processed then it should place the email into a folder called "done" so the email will not be processed twice,  but the question can someone help me here how can i code it?

    maybe if someone has a link from something similar could be helpful.

    thanks for all of you.

    Friday, June 22, 2012 12:11 AM
  • Hi

    I think you need to star form this KB. This KB will let you know how cto create a script for Outlook rule.

    Best Regards,

    T.X.


    征诛志异,三让两家王朝
    功同开辟,一桮万古江南

    Monday, June 25, 2012 10:44 AM
  • This articles is about transfer info from Excel do Outlook and from Outlook to Excel by VBA.

    Translate for your lang.


    Oskar Shon, Office System MVP

    Press if Helpful; Answer when a problem solved

    Monday, June 25, 2012 7:34 PM
  • ok, i looked in all links here i see you dont get my problem, let me get you in to my macro, and look where i get stumbled,

    the macro starts as follows,

    ' i have a rule which is set that each time an email from example@sample.com comes in, it runs this script,

    Sub CopyToExcell(MyMail As MailItem)

    'this will get my email location,folder,and items'

    Dim olApp As Outlook.Application
    Dim olNs As NameSpace
    Dim Fldr As MAPIFolder
    Dim olMail As Variant

    'this will get my excel sheet where the data should be placed'

    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet

    'this gives the target from what i am talking in this macro'

    Dim olItem As Outlook.MailItem

    'this will take the text from the email'

    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim oRng As Range
    Dim I As Long
    Dim rCount As Long
    Dim bXStarted As Boolean

    'this is where the path of my sheet is located'

    Const strPath As String = "C:\Users\xxx\Desktop\Test.xlsx" 'the path of the workbook

    'now the boll is rolling'

    'gets the email folder'

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

    'gets the excel sheet'

    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    'here is where i get stuck'

    'Process each email that triggered this macro to run'

    For Each olItem In Application.ActiveExplorer.Selection

    HERE I GET AN ERROR "NO ITEM SELECTED

    can you give me a code what i should write over here instead of "For Each olItem In Application.ActiveExplorer.Selection"

    i really appreciate all your help!!

    Monday, June 25, 2012 8:56 PM
  • Hi Auto2,

    Sub CopyToExcell(MyMail As MailItem)

    In this sentence a variable MyMail is a specific mail which you received right now. You can use it in your sub block. Your snippet confused me quite a bit. I think you didn't catch the mean of the KB which I shown you indeed. In Sub CopyToExcell only one thing you need to do: Open Excel and fill the information from MyMail in it.

    Best Regards,

    T.X.


    征诛志异,三让两家王朝
    功同开辟,一桮万古江南

    • Marked as answer by Sol Stein Tuesday, June 26, 2012 9:19 PM
    Tuesday, June 26, 2012 12:56 PM
  • thank you very much, you was right; i removed all outlook codes, and i based on mymail as mailitem, and it started to work great!

    here is my new VBA for those who have the same issue,

    first go to the vba project and paste this;

    Sub CopyToExcell(MyMail As MailItem)

    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim oRng As Range
    Dim I As Long
    Dim bXStarted As Boolean
    Const strPath As String = "specify the name of your excel sheet'.xlsx"
    Const sFilePath As String = "K:\Users\ 'specify the location of the sheet'"

    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(sFilePath & strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    'Process each selected record
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
        sText = MyMail.Body
        vText = Split(sText, Chr(13))
        'Find the next empty line of the worksheet
    Dim rCount As Long
        rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
        rCount = rCount + 1

        'Check each line of text in the message body
        For I = UBound(vText) To 0 Step -1
            If InStr(1, vText(I), "Name:") > 0 Then
                vItem = Split(vText(I), Chr(58))
                xlSheet.Range("A" & rCount) = Trim(vItem(1))
            End If

            If InStr(1, vText(I), "Phone:") > 0 Then
                vItem = Split(vText(I), Chr(58))
                xlSheet.Range("B" & rCount) = Trim(vItem(1))
            End If


        Next I
        xlWB.Save

    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    End Sub

    then create a rule select the name from from your sender, and next check the box run a script, choose CopyToExcell, and you are good to go;

    thank you all of you for helping me with this rule!

    Tuesday, June 26, 2012 9:29 PM