How to copy Outlook mail message into excel using VBA or Macros

Question

I'm a newbie in VBA and Macros. If someone helps me with VBA code and macros, it will be helpful.

Daily I'll receive around 50-60 mails with one standard subject: "Task Completed". I have created a rule to all those mail to move to a specific folder: "Task Completed".

Reading all 50-60 mails a day and updating all mails is very much time consuming. All 50-60 mails coming to my inbox will have same subject but from different users. Body of mail will vary.

I'm using Outlook 2010 and Excel 2010.

Answer 1

Since you have not mentioned what needs to be copied, I have left that section empty in the code below.

Also you don't need to move the email to the folder first and then run the macro in that folder. You can run the macro on the incoming mail and then move it to the folder at the same time.

This will get you started. I have commented the code so that you will not face any problem understanding it.

First paste the below mentioned code in the outlook module.

Then

1. Click on Tools~~>Rules and Alerts
2. Click on "New Rule"
3. Click on "start from a blank rule"
4. Select "Check messages When they arrive"
5. Under conditions, click on "with specific words in the subject"
6. Click on "specific words" under rules description.
7. Type the word that you want to check in the dialog box that pops up and click on "add".
8. Click "Ok" and click next
9. Select "move it to specified folder" and also select "run a script" in the same box
10. In the box below, specify the specific folder and also the script (the macro that you have in module) to run.
11. Click on finish and you are done.

When the new email arrives not only will the email move to the folder that you specify but data from it will be exported to Excel as well.

UNTESTED

Const xlUp As Long = -4162

Sub ExportToExcel(MyMail As MailItem)
    Dim strID As String, olNS As Outlook.Namespace
    Dim olMail As Outlook.MailItem
    Dim strFileName As String

    '~~> Excel Variables
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object
    Dim lRow As Long

    strID = MyMail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)

    '~~> Establish an EXCEL application object
    On Error Resume Next
    Set oXLApp = GetObject(, "Excel.Application")

    '~~> If not found then create new instance
    If Err.Number <> 0 Then
        Set oXLApp = CreateObject("Excel.Application")
    End If
    Err.Clear
    On Error GoTo 0

    '~~> Show Excel
    oXLApp.Visible = True

    '~~> Open the relevant file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")

    '~~> Set the relevant output sheet. Change as applicable
    Set oXLws = oXLwb.Sheets("Sheet1")

    lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1

    '~~> Write to outlook
    With oXLws
        '
        '~~> Code here to output data from email to Excel File
        '~~> For example
        '
        .Range("A" & lRow).Value = olMail.Subject
        .Range("B" & lRow).Value = olMail.SenderName
        '
    End With

    '~~> Close and Clean up Excel
    oXLwb.Close (True)
    oXLApp.Quit
    Set oXLws = Nothing
    Set oXLwb = Nothing
    Set oXLApp = Nothing

    Set olMail = Nothing
    Set olNS = Nothing
End Sub

FOLLOWUP

To extract the contents from your email body, you can split it using SPLIT() and then parsing out the relevant information from it. See this example

Dim MyAr() As String

MyAr = Split(olMail.body, vbCrLf)

For i = LBound(MyAr) To UBound(MyAr)
    '~~> This will give you the contents of your email
    '~~> on separate lines
    Debug.Print MyAr(i)
Next i