By Mallur


2012-08-09 03:52:56 8 Comments

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.

enter image description here

2 comments

@Tony Dallimore 2012-08-27 17:05:45

New introduction 2

In the previous version of macro "SaveEmailDetails" I used this statement to find Inbox:

Set FolderTgt = CreateObject("Outlook.Application"). _
              GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

I have since installed a newer version of Outlook and I have discovered that it does not use the default Inbox. For each of my email accounts, it created a separate store (named for the email address) each with its own Inbox. None of those Inboxes is the default.

This macro, outputs the name of the store holding the default Inbox to the Immediate Window:

Sub DsplUsernameOfDefaultStore()

  Dim NS As Outlook.NameSpace
  Dim DefaultInboxFldr As MAPIFolder

  Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
  Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)

  Debug.Print DefaultInboxFldr.Parent.Name

End Sub

On my installation, this outputs: "Outlook Data File".

I have added an extra statement to macro "SaveEmailDetails" that shows how to access the Inbox of any store.

New introduction 1

A number of people have picked up the macro below, found it useful and have contacted me directly for further advice. Following these contacts I have made a few improvements to the macro so I have posted the revised version below. I have also added a pair of macros which together will return the MAPIFolder object for any folder with the Outlook hierarchy. These are useful if you wish to access other than a default folder.

The original text referenced one question by date which linked to an earlier question. The first question has been deleted so the link has been lost. That link was to Update excel sheet based on outlook mail (closed)

Original text

There are a surprising number of variations of the question: "How do I extract data from Outlook emails to Excel workbooks?" For example, two questions up on [outlook-vba] the same question was asked on 13 August. That question references a variation from December that I attempted to answer.

For the December question, I went overboard with a two part answer. The first part was a series of teaching macros that explored the Outlook folder structure and wrote data to text files or Excel workbooks. The second part discussed how to design the extraction process. For this question Siddarth has provided an excellent, succinct answer and then a follow-up to help with the next stage.

What the questioner of every variation appears unable to understand is that showing us what the data looks like on the screen does not tell us what the text or html body looks like. This answer is an attempt to get past that problem.

The macro below is more complicated than Siddarth’s but a lot simpler that those I included in my December answer. There is more that could be added but I think this is enough to start with.

The macro creates a new Excel workbook and outputs selected properties of every email in Inbox to create this worksheet:

Example of worksheet created by macro

Near the top of the macro there is a comment containing eight hashes (#). The statement below that comment must be changed because it identifies the folder in which the Excel workbook will be created.

All other comments containing hashes suggest amendments to adapt the macro to your requirements.

How are the emails from which data is to be extracted identified? Is it the sender, the subject, a string within the body or all of these? The comments provide some help in eliminating uninteresting emails. If I understand the question correctly, an interesting email will have Subject = "Task Completed".

The comments provide no help in extracting data from interesting emails but the worksheet shows both the text and html versions of the email body if they are present. My idea is that you can see what the macro will see and start designing the extraction process.

This is not shown in the screen image above but the macro outputs two versions on the text body. The first version is unchanged which means tab, carriage return, line feed are obeyed and any non-break spaces look like spaces. In the second version, I have replaced these codes with the strings [TB], [CR], [LF] and [NBSP] so they are visible. If my understanding is correct, I would expect to see the following within the second text body:

Activity[TAB]Count[CR][LF]Open[TAB]35[CR][LF]HCQA[TAB]42[CR][LF]HCQC[TAB]60[CR][LF]HAbst[TAB]50 45 5 2 2 1[CR][LF] and so on

Extracting the values from the original of this string should not be difficult.

I would try amending my macro to output the extracted values in addition to the email’s properties. Only when I have successfully achieved this change would I attempt to write the extracted data to an existing workbook. I would also move processed emails to a different folder. I have shown where these changes must be made but give no further help. I will respond to a supplementary question if you get to the point where you need this information.

Good luck.

Latest version of macro included within the original text

Option Explicit
Public Sub SaveEmailDetails()

  ' This macro creates a new Excel workbook and writes to it details
  ' of every email in the Inbox.

  ' Lines starting with hashes either MUST be changed before running the
  ' macro or suggest changes you might consider appropriate.

  Dim AttachCount As Long
  Dim AttachDtl() As String
  Dim ExcelWkBk As Excel.Workbook
  Dim FileName As String
  Dim FolderTgt As MAPIFolder
  Dim HtmlBody As String
  Dim InterestingItem As Boolean
  Dim InxAttach As Long
  Dim InxItemCrnt As Long
  Dim PathName As String
  Dim ReceivedTime As Date
  Dim RowCrnt As Long
  Dim SenderEmailAddress As String
  Dim SenderName As String
  Dim Subject As String
  Dim TextBody As String
  Dim xlApp As Excel.Application

  ' The Excel workbook will be created in this folder.
  ' ######## Replace "C:\DataArea\SO" with the name of a folder on your disc.
  PathName = "C:\DataArea\SO"

  ' This creates a unique filename.
  ' #### If you use a version of Excel 2003, change the extension to "xls".
  FileName = Format(Now(), "yymmdd hhmmss") & ".xlsx"

  ' Open own copy of Excel
  Set xlApp = Application.CreateObject("Excel.Application")
  With xlApp
    ' .Visible = True         ' This slows your macro but helps during debugging
    .ScreenUpdating = False ' Reduces flash and increases speed
    ' Create a new workbook
    ' #### If updating an existing workbook, replace with an
    ' #### Open workbook statement.
    Set ExcelWkBk = xlApp.Workbooks.Add
    With ExcelWkBk
      ' #### None of this code will be useful if you are adding
      ' #### to an existing workbook.  However, it demonstrates a
      ' #### variety of useful statements.
      .Worksheets("Sheet1").Name = "Inbox"    ' Rename first worksheet
      With .Worksheets("Inbox")
        ' Create header line
        With .Cells(1, "A")
          .Value = "Field"
          .Font.Bold = True
        End With
        With .Cells(1, "B")
          .Value = "Value"
          .Font.Bold = True
        End With
        .Columns("A").ColumnWidth = 18
        .Columns("B").ColumnWidth = 150
      End With
    End With
    RowCrnt = 2
  End With

  ' FolderTgt is the folder I am going to search.  This statement says
  ' I want to seach the Inbox.  The value "olFolderInbox" can be replaced
  ' to allow any of the standard folders to be searched.
  ' See FindSelectedFolder() for a routine that will search for any folder.
  Set FolderTgt = CreateObject("Outlook.Application"). _
              GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  ' #### Use the following the access a non-default Inbox.
  ' #### Change "Xxxx" to name of one of your store you want to access.
  Set FolderTgt = Session.Folders("Xxxx").Folders("Inbox")

  ' This examines the emails in reverse order. I will explain why later.
  For InxItemCrnt = FolderTgt.Items.Count To 1 Step -1
    With FolderTgt.Items.Item(InxItemCrnt)
      ' A folder can contain several types of item: mail items, meeting items,
      ' contacts, etc.  I am only interested in mail items.
      If .Class = olMail Then
        ' Save selected properties to variables
        ReceivedTime = .ReceivedTime
        Subject = .Subject
        SenderName = .SenderName
        SenderEmailAddress = .SenderEmailAddress
        TextBody = .Body
        HtmlBody = .HtmlBody
        AttachCount = .Attachments.Count
        If AttachCount > 0 Then
          ReDim AttachDtl(1 To 7, 1 To AttachCount)
          For InxAttach = 1 To AttachCount
            ' There are four types of attachment:
            '  *   olByValue       1
            '  *   olByReference   4
            '  *   olEmbeddedItem  5
            '  *   olOLE           6
            Select Case .Attachments(InxAttach).Type
              Case olByValue
            AttachDtl(1, InxAttach) = "Val"
              Case olEmbeddeditem
            AttachDtl(1, InxAttach) = "Ebd"
              Case olByReference
            AttachDtl(1, InxAttach) = "Ref"
              Case olOLE
            AttachDtl(1, InxAttach) = "OLE"
              Case Else
            AttachDtl(1, InxAttach) = "Unk"
            End Select
            ' Not all types have all properties.  This code handles
            ' those missing properties of which I am aware.  However,
            ' I have never found an attachment of type Reference or OLE.
            ' Additional code may be required for them.
            Select Case .Attachments(InxAttach).Type
              Case olEmbeddeditem
                AttachDtl(2, InxAttach) = ""
              Case Else
                AttachDtl(2, InxAttach) = .Attachments(InxAttach).PathName
            End Select
            AttachDtl(3, InxAttach) = .Attachments(InxAttach).FileName
            AttachDtl(4, InxAttach) = .Attachments(InxAttach).DisplayName
            AttachDtl(5, InxAttach) = "--"
            ' I suspect Attachment had a parent property in early versions
            ' of Outlook. It is missing from Outlook 2016.
            On Error Resume Next
            AttachDtl(5, InxAttach) = .Attachments(InxAttach).Parent
            On Error GoTo 0
            AttachDtl(6, InxAttach) = .Attachments(InxAttach).Position
            ' Class 5 is attachment.  I have never seen an attachment with
            ' a different class and do not see the purpose of this property.
            ' The code will stop here if a different class is found.
            Debug.Assert .Attachments(InxAttach).Class = 5
            AttachDtl(7, InxAttach) = .Attachments(InxAttach).Class
          Next
        End If
        InterestingItem = True
      Else
        InterestingItem = False
      End If
    End With
    ' The most used properties of the email have been loaded to variables but
    ' there are many more properies.  Press F2.  Scroll down classes until
    ' you find MailItem.  Look through the members and note the name of
    ' any properties that look useful.  Look them up using VB Help.

    ' #### You need to add code here to eliminate uninteresting items.
    ' #### For example:
    'If SenderEmailAddress <> "[email protected]" Then
    '  InterestingItem = False
    'End If
    'If InStr(Subject, "Accounts payable") = 0 Then
    '  InterestingItem = False
    'End If
    'If AttachCount = 0 Then
    '  InterestingItem = False
    'End If

    ' #### If the item is still thought to be interesting I
    ' #### suggest extracting the required data to variables here.

    ' #### You should consider moving processed emails to another
    ' #### folder.  The emails are being processed in reverse order
    ' #### to allow this removal of an email from the Inbox without
    ' #### effecting the index numbers of unprocessed emails.

    If InterestingItem Then
      With ExcelWkBk
        With .Worksheets("Inbox")
          ' #### This code creates a dividing row and then
          ' #### outputs a property per row.  Again it demonstrates
          ' #### statements that are likely to be useful in the final
          ' #### version
          ' Create dividing row between emails
          .Rows(RowCrnt).RowHeight = 5
          .Range(.Cells(RowCrnt, "A"), .Cells(RowCrnt, "B")) _
                                      .Interior.Color = RGB(0, 255, 0)
          RowCrnt = RowCrnt + 1
          .Cells(RowCrnt, "A").Value = "Sender name"
          .Cells(RowCrnt, "B").Value = SenderName
          RowCrnt = RowCrnt + 1
          .Cells(RowCrnt, "A").Value = "Sender email address"
          .Cells(RowCrnt, "B").Value = SenderEmailAddress
          RowCrnt = RowCrnt + 1
          .Cells(RowCrnt, "A").Value = "Received time"
          With .Cells(RowCrnt, "B")
            .NumberFormat = "@"
            .Value = Format(ReceivedTime, "mmmm d, yyyy h:mm")
          End With
          RowCrnt = RowCrnt + 1
          .Cells(RowCrnt, "A").Value = "Subject"
          .Cells(RowCrnt, "B").Value = Subject
          RowCrnt = RowCrnt + 1
          If AttachCount > 0 Then
            .Cells(RowCrnt, "A").Value = "Attachments"
            .Cells(RowCrnt, "B").Value = "Inx|Type|Path name|File name|Display name|Parent|Position|Class"
            RowCrnt = RowCrnt + 1
            For InxAttach = 1 To AttachCount
              .Cells(RowCrnt, "B").Value = InxAttach & "|" & _
                                           AttachDtl(1, InxAttach) & "|" & _
                                           AttachDtl(2, InxAttach) & "|" & _
                                           AttachDtl(3, InxAttach) & "|" & _
                                           AttachDtl(4, InxAttach) & "|" & _
                                           AttachDtl(5, InxAttach) & "|" & _
                                           AttachDtl(6, InxAttach) & "|" & _
                                           AttachDtl(7, InxAttach)
              RowCrnt = RowCrnt + 1
            Next
          End If
          If TextBody <> "" Then

            ' ##### This code was in the original version of the macro
            ' ##### but I did not find it as useful as the other version of
            ' ##### the text body.  See below
            ' This outputs the text body with CR, LF and TB obeyed
            'With .Cells(RowCrnt, "A")
            '  .Value = "text body"
            '  .VerticalAlignment = xlTop
            'End With
            'With .Cells(RowCrnt, "B")
            '  ' The maximum size of a cell 32,767
            '  .Value = Mid(TextBody, 1, 32700)
            '  .WrapText = True
            'End With
            'RowCrnt = RowCrnt + 1

            ' This outputs the text body with NBSP, CR, LF and TB
            ' replaced by strings.
            With .Cells(RowCrnt, "A")
              .Value = "text body"
              .VerticalAlignment = xlTop
            End With
            TextBody = Replace(TextBody, Chr(160), "[NBSP]")
            TextBody = Replace(TextBody, vbCr, "[CR]")
            TextBody = Replace(TextBody, vbLf, "[LF]")
            TextBody = Replace(TextBody, vbTab, "[TB]")
            With .Cells(RowCrnt, "B")
              ' The maximum size of a cell 32,767
              .Value = Mid(TextBody, 1, 32700)
              .WrapText = True
            End With
            RowCrnt = RowCrnt + 1
          End If

          If HtmlBody <> "" Then

            ' ##### This code was in the original version of the macro
            ' ##### but I did not find it as useful as the other version of
            ' ##### the html body.  See below
            ' This outputs the html body with CR, LF and TB obeyed
            'With .Cells(RowCrnt, "A")
            '  .Value = "Html body"
            '  .VerticalAlignment = xlTop
            'End With
            'With .Cells(RowCrnt, "B")
            '  .Value = Mid(HtmlBody, 1, 32700)
            '  .WrapText = True
            'End With
            'RowCrnt = RowCrnt + 1

            ' This outputs the html body with NBSP, CR, LF and TB
            ' replaced by strings.
            With .Cells(RowCrnt, "A")
              .Value = "Html body"
              .VerticalAlignment = xlTop
            End With
            HtmlBody = Replace(HtmlBody, Chr(160), "[NBSP]")
            HtmlBody = Replace(HtmlBody, vbCr, "[CR]")
            HtmlBody = Replace(HtmlBody, vbLf, "[LF]")
            HtmlBody = Replace(HtmlBody, vbTab, "[TB]")
            With .Cells(RowCrnt, "B")
              .Value = Mid(HtmlBody, 1, 32700)
              .WrapText = True
            End With
            RowCrnt = RowCrnt + 1

          End If
        End With
      End With
    End If
  Next

  With xlApp
    With ExcelWkBk
      ' Write new workbook to disc
      If Right(PathName, 1) <> "\" Then
        PathName = PathName & "\"
      End If
      .SaveAs FileName:=PathName & FileName
      .Close
    End With
    .Quit   ' Close our copy of Excel
  End With

  Set xlApp = Nothing       ' Clear reference to Excel

End Sub

Macros not included in original post but which some users of above macro have found useful.

Public Sub FindSelectedFolder(ByRef FolderTgt As MAPIFolder, _
                              ByVal NameTgt As String, ByVal NameSep As String)

  ' This routine (and its sub-routine) locate a folder within the hierarchy and
  ' returns it as an object of type MAPIFolder

  ' NameTgt   The name of the required folder in the format:
  '              FolderName1 NameSep FolderName2 [ NameSep FolderName3 ] ...
  '           If NameSep is "|", an example value is "Personal Folders|Inbox"
  '           FolderName1 must be an outer folder name such as
  '           "Personal Folders". The outer folder names are typically the names
  '           of PST files.  FolderName2 must be the name of a folder within
  '           Folder1; in the example "Inbox".  FolderName2 is compulsory.  This
  '           routine cannot return a PST file; only a folder within a PST file.
  '           FolderName3, FolderName4 and so on are optional and allow a folder
  '           at any depth with the hierarchy to be specified.
  ' NameSep   A character or string used to separate the folder names within
  '           NameTgt.
  ' FolderTgt On exit, the required folder.  Set to Nothing if not found.

  ' This routine initialises the search and finds the top level folder.
  ' FindSelectedSubFolder() is used to find the target folder within the
  ' top level folder.

  Dim InxFolderCrnt As Long
  Dim NameChild As String
  Dim NameCrnt As String
  Dim Pos As Long
  Dim TopLvlFolderList As Folders

  Set FolderTgt = Nothing   ' Target folder not found

  Set TopLvlFolderList = _
          CreateObject("Outlook.Application").GetNamespace("MAPI").Folders

  ' Split NameTgt into the name of folder at current level
  ' and the name of its children
  Pos = InStr(NameTgt, NameSep)
  If Pos = 0 Then
    ' I need at least a level 2 name
    Exit Sub
  End If
  NameCrnt = Mid(NameTgt, 1, Pos - 1)
  NameChild = Mid(NameTgt, Pos + 1)

  ' Look for current name.  Drop through and return nothing if name not found.
  For InxFolderCrnt = 1 To TopLvlFolderList.Count
    If NameCrnt = TopLvlFolderList(InxFolderCrnt).Name Then
      ' Have found current name. Call FindSelectedSubFolder() to
      ' look for its children
      Call FindSelectedSubFolder(TopLvlFolderList.Item(InxFolderCrnt), _
                                            FolderTgt, NameChild, NameSep)
      Exit For
    End If
  Next

End Sub
Public Sub FindSelectedSubFolder(FolderCrnt As MAPIFolder, _
                      ByRef FolderTgt As MAPIFolder, _
                      ByVal NameTgt As String, ByVal NameSep As String)

  ' See FindSelectedFolder() for an introduction to the purpose of this routine.
  ' This routine finds all folders below the top level

  ' FolderCrnt The folder to be seached for the target folder.
  ' NameTgt    The NameTgt passed to FindSelectedFolder will be of the form:
  '               A|B|C|D|E
  '            A is the name of outer folder which represents a PST file.
  '            FindSelectedFolder() removes "A|" from NameTgt and calls this
  '            routine with FolderCrnt set to folder A to search for B.
  '            When this routine finds B, it calls itself with FolderCrnt set to
  '            folder B to search for C.  Calls are nested to whatever depth are
  '            necessary.
  ' NameSep    As for FindSelectedSubFolder
  ' FolderTgt  As for FindSelectedSubFolder

  Dim InxFolderCrnt As Long
  Dim NameChild As String
  Dim NameCrnt As String
  Dim Pos As Long

  ' Split NameTgt into the name of folder at current level
  ' and the name of its children
  Pos = InStr(NameTgt, NameSep)
  If Pos = 0 Then
    NameCrnt = NameTgt
    NameChild = ""
  Else
    NameCrnt = Mid(NameTgt, 1, Pos - 1)
    NameChild = Mid(NameTgt, Pos + 1)
  End If

  ' Look for current name.  Drop through and return nothing if name not found.
  For InxFolderCrnt = 1 To FolderCrnt.Folders.Count
    If NameCrnt = FolderCrnt.Folders(InxFolderCrnt).Name Then
      ' Have found current name.
      If NameChild = "" Then
        ' Have found target folder
        Set FolderTgt = FolderCrnt.Folders(InxFolderCrnt)
      Else
        'Recurse to look for children
        Call FindSelectedSubFolder(FolderCrnt.Folders(InxFolderCrnt), _
                                            FolderTgt, NameChild, NameSep)
      End If
      Exit For
    End If
  Next

  ' If NameCrnt not found, FolderTgt will be returned unchanged.  Since it is
  ' initialised to Nothing at the beginning, that will be the returned value.

End Sub

@Siddharth Rout 2012-08-09 05:50:10

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

@Mallur 2012-08-09 06:27:25

Thanks for the code. But i'm getting an error message on this line 'code' lRow = oXLws.Range("A" & oXLws.Rows.Count).End(xlUp).Row + 1

@Siddharth Rout 2012-08-09 07:18:11

There were few typos. I have updated the code above. test it now.

@Mallur 2012-08-09 08:52:46

Thank you very much Siddharth Rout. I have replaced olMail.Subject to olMail.Senton and it worked fine. But i need to copy the body of mail too. How do i do that.

@Mallur 2012-08-09 09:01:50

Siddharth Rout, to be more precise - I have a excel with 16-18 sheets (activities as sheet names, in every sheet have senders name and date). When ever i recieve mail with task completed subject, VBA has search the activity in the mail and lookup in excel for that activity sheet and update the count against the senders name and date (Lookup for sent date).

@Mallur 2012-08-09 17:02:34

is it possible to write a code with the conditions I have mentioned? If so thn pls help me. Thnks

@Siddharth Rout 2012-08-09 17:20:18

Pradeep, how are you planning to get the activity from the body of the email? Also anything that you want to share via email, you can share here :)

@Mallur 2012-08-11 05:00:03

@Siddharth Rout: In the body of the mail, sender updates count with activity. Ex. Body message: Open - 35, HCQC - 62. In the excel I hv created Open and HCQC two sheets, and want to update open count in open sheet and HCQC count in HCQC sheet against the sender.

@Siddharth Rout 2012-08-11 05:06:19

Can you post a screenshot of a sample email?

@Mallur 2012-08-11 05:06:24

@Pradeep Kumar: Yes, Siddharth has explained very well n hope he will help me the solution. I thnk y cnt u help me too instead of commenting;)

@Mallur 2012-08-11 05:07:57

@Siddharth Rout: I can do tht but today i'm not wrking n how to post a screenshot?

@Siddharth Rout 2012-08-11 05:24:39

In that case let's wait till you post the screenshot? Don't worry we will get this sorted :) BTW Pradeep Kumar upvoted this post ;) He is not the one who downvoted... Seems like someone else downvoted in retaliation. But no worries...

@Mallur 2012-08-13 05:55:47

Hi @SiddharthRout, I tried uploading screenshot of a sample mail, but unfortunately i do not have 10 maximum reputation to add image :-(. What to do now? This is how i'll receive mails (Sample) - Hi, Please find the enclosed daily activity report. Activity Count Open 35 HCQA 42 HCQC 60 HAbst 50 45 5 2 2 1 Drg 649 AR 23 FA 05 RM 1241 Pradeep M. We have around 16-18 activity, but not all activity will be performed in a day. I hope this will help you.

@Siddharth Rout 2012-08-13 05:56:37

I have upvoted your post. Try uploading the image now.

@Mallur 2012-08-13 05:59:55

Thanks Siddharth Rout.....i have uploaded the screenshot for your reference

@Siddharth Rout 2012-08-13 06:01:52

I just remembered that i am not able to access images/gravatars uploaded in imgur. Would it also be possible to upload it in wikisend.com and share the link here in the comment?

@Mallur 2012-08-13 06:10:22

@Siddharth Rout 2012-08-13 06:16:08

Ok what you need to do is now split the olMail.Body on vbcrlf or vbnewline and then loop the array to extract the contents of the email. Would you like to give it a try?

@Mallur 2012-08-13 06:23:31

@SiddharthRout: I'm really sorry to say this, i'm new to VBA and never tried coding.

@Siddharth Rout 2012-08-13 06:29:33

I can give you an example but you will have to really do it on your own. Is that ok?

@Mallur 2012-08-13 06:33:03

Yeah.....i'll try

@Siddharth Rout 2012-08-13 06:33:19

Kool :) Updating my post above in 2 mins.

@Mallur 2012-08-13 06:42:22

After copying data from mail to excel.....it is closing all the other excel i have opened. So if i remove this 'code' '~~> 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 the excel will not close....right?

@Siddharth Rout 2012-08-13 06:43:30

The code that I gave goes before '~~> Close and Clean up Excel

@Mallur 2012-08-13 06:45:55

I'll try the example u gve, but jus wanted to know about close and clean...:) Thanks

@Siddharth Rout 2012-08-13 07:07:09

Close and Clean is to save and close your excel file after you have finished working with it and finally disconnecting with the Excel object.

@Mallur 2012-08-13 07:09:21

Siddhart i have added and tried the follow up code in 'code' With oXLws ' '~~> Code here to output data from email to Excel File '~~> For example ' Dim MyAR() As String MyAR = Split(olMail.Body, vbCrLf) For i = LBound(MyAR) To LBound(MyAR) '~~> This will give you the contents of your email '~~> on separate lines Debug.Print MyAR(i) Next i '.Range("A" & lRow).Value = olMail.SenderName '.Range("B" & lRow).Value = olMail.SentOn ' End With but not able to copy the mail body to excel :(

@Siddharth Rout 2012-08-13 07:48:25

MyAR(i) will give you details like Open 35 or AR 23. Debug.Print will always print it to the immediate window. You have to extract the details from those...

@Mallur 2012-08-13 08:37:41

VBA is very difficult....:-?

@Mallur 2012-08-13 10:27:19

+5 Hi Siddharth Rout - I tried extracting content from outlook to excel with your example code and i'm unable to write a code and didnt get the desired solution. Its ok, i'll try. But Thank You so much for your time guiding and suggesting me few things in VBA. Vry much appreciated.

@user206168 2013-12-30 20:02:31

I would like to know solution also please.

@user206168 2013-12-30 21:17:43

I found work around for this. Copy whole body to excel column B or whatever you feel like, then use excel formula such as mid,search,find,trim,subtitude to get to the data you need from the whole email body. You can also use VBA macros to erase the unwanted data when excel open everytime. good luck.

@shubhraj 2015-07-20 14:09:23

@SiddharthRout- Is there a way to get hyperlinks from the body of emails in to the excel file only?? Since I ran the script, it fetched the body in Normal font not as hyperlinks..

@Siddharth Rout 2015-07-21 06:16:36

@shubhraj: Yes it is possible. After you retrieve the body, you can use RegEx to extract the emails from the body and then when you are writing it to excel then re-create the hyperlinks there

@Siddharth Rout 2015-07-21 06:30:05

@shubhraj: See This link. This will help you re-create the hyperlinks

@user3271518 2015-11-09 19:57:25

your last function doesnt work For i = LBound(MyAr) To LBound(MyAr) should be For i = LBound(MyAr) To UBound(MyAr)

@Siddharth Rout 2015-11-09 20:00:10

@user3271518: Thanks :) Typo fixed :)

Related Questions

Sponsored Content

1 Answered Questions

1 Answered Questions

Outlook and Excel VBA integration for Auto Reports

1 Answered Questions

Outlook VBA to pull data from incoming mails with specific subject into Excel file

1 Answered Questions

[SOLVED] Outlook 2013 VBA Macro Not Running on New Messages

2 Answered Questions

[SOLVED] How to send an Excel chart from outlook macro

1 Answered Questions

How to run an Excel macro after a new mail is received in Outlook?

1 Answered Questions

[SOLVED] Excel VBA for searching in mails of Outlook

1 Answered Questions

2 Answered Questions

[SOLVED] Outlook VBA macro not recognized

1 Answered Questions

Sponsored Content