Update excel sheet based on outlook mail [closed]

Answer 1

Introduction

In the first version of this answer, I referred you to another question which I now know you will not be able to read.

All the code you need is here but this is not written as an immediate solution. This is a tutorial which introduces you to the Outlook object model, getting data out of the outlook database and into an Excel workbook. Don't worry that you are not "a 'pro' or 'techie'"; once we were all newbies. Work through the sections. Don't worry if you don't understand it all. Just pick out the bits you need now. When you want to enhance your solution, come back to this tutorial and the code which you will have copied to your disc.

In the following sections, AnswerA() and AnswerB() are intended to help you understand the folder structure. AnswerC1() is also a short term training aid. However, AnswerC2() and AnswerC3() are subroutines that you may need permenently. If you do keep them, I suggest you rename them; for example: FindFolder() and FindFolderSub().

AnswerD() is also a training aid but one you should retain. This shows you how to access a few mail item properties but I you may need access to more mail item properties than I have shown. Within the VB Editor, click F2 to display the Object Explorer. Scroll down the list of classes to MailItem. You will be shown a list of over 100 methods and properties. Some are obvious but you will have to use VB Help to discover the purpose of many. Expand AnswerD() to use methods or display properties you think might be useful.

AnswerE() is a development aid but also provides the structure for your macro. Currently it outputs to disc the text and html bodies of the mail items within a folder. You do not want to do this at the moment but you might. I archive all my emails to Excel. I create one row per email with columns for sender, recipients, subject, dates, etc. I save the text body, html body and any attachments to disc and create hyperlinks to them. I have emails going back years from multiple Outlook installations.

AnswerF1() shows you how to create a new Excel workbook and AnswerF2() shows you how to open an existing Excel workbook. I assume AnswerF2() is what you need.

There is a lot here but if you work through it steadily you will come to understand the Outlook object model and how to achieve your objective.

Health warning

Everything in this answer was discovered by experimentation. I started with VB Help, used F2 to access the object model and experimented until I found what worked. I did buy a highly recommended reference book but it contained nothing important I had not discovered and omitted much that I had discovered.

I suspect that a key feature of the knowledge I have gained is that it is based on many different installations. Some of the problems encountered may have been the result of installation mistakes which would explain why reference book authors did not know of them.

The code below has been tested with Excel 2003 and Outlook Exchange 2003 and 2007.

Getting started if you are unfamiliar with Outlook VBA

Open "Outlook" or "Outlook Exchange". These macros do not work with "Outlook Express".

From the toolbar, select Tools, Macro, Security. Change the security level to "Medium" if it is not already at that level. This means that macros can be run but only with your explicit approval.

To start the Outlook VB Editor either:

1) From the toolbar, select Tools, Macro, Macros or click Alt+F11 2) Select Enable macros.

From the tool bar, select Insert, Module.

You can see one, two or three windows. Down the left should be the Project Explorer. You do not need it today but, if it is missing, click Ctrl+R to display it. To the right, at the top, is the area into which you will place the code. At the bottom you should see the Immediate Window. If the Immediate Window is missing, click Ctrl+G to display it. The macros below all use the Immediate Window for output so you must be able to see it.

The cursor will be in the code area.

Enter: Option Explicit.

This instructs the VB Editor to check that all variables are defined. The code below have been tested but this avoids one type of error in any code you may enter.

One by one, copy and paste the macros below into the code area.

Macros AnswerC(), AnswerD(), Answer(E), AnswerF1() and AnswerF2() will require some modification before running. Instructions within the macro.

To run a macro, place the cursor within it and press F5.

Accessing the top two folder levels

The top level of folders are of type Folders. All subfolders are of type MAPIFolder. I have never tried accessing the top level other than as a means of getting to the subfolders.

AnswerA() gets access to the Outlook Exchange database and outputs the names of the top level folders to the Immediate Window.

Sub AnswerA()

  Dim InxIFLCrnt As Integer
  Dim TopLvlFolderList As Folders

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

  For InxIFLCrnt = 1 To TopLvlFolderList.Count
    Debug.Print TopLvlFolderList(InxIFLCrnt).Name
  Next

End Sub

AnswerB() outputs the names of the top level folders and their immediate children.

Sub AnswerB()

      Dim InxIFLCrnt As Integer
      Dim InxISLCrnt As Integer
      Dim SndLvlFolderList As MAPIFolder
      Dim TopLvlFolderList As Folders

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

      For InxIFLCrnt = 1 To TopLvlFolderList.Count
        Debug.Print TopLvlFolderList(InxIFLCrnt).Name
        Set SndLvlFolderList = TopLvlFolderList.Item(InxIFLCrnt)
        For InxISLCrnt = 1 To SndLvlFolderList.Folders.Count
          Debug.Print "   " & SndLvlFolderList.Folders(InxISLCrnt).Name
        Next
      Next

End Sub

The problem with AnswerB() is that the children can have children can have children to any depth. You need to be able to find a particular folder whatever the depth.

Find named folder

If you want to search a default folder such as "Inbox" or "Sent Items" you will not need this code. If you copy the messages containing tables to a different folder you will need this code. Even if you decide you do not need this code now, I suggest you keep it in case you need it in the future.

The code below uses two sub-routines. The caller assembles a folder name such as "Personal Folders|MailBox|Inbox". The sub-routines work down the hierarchy and return the required folder as an object if it is found.

Note: the special case of locating a default folder such as "Inbox" or "Sent Items" is discussed later.

Sub AnswerC1()

  ' This routine wants a folder.  It does nothing but display its name. 

  Dim FolderNameTgt As String
  Dim FolderTgt As MAPIFolder

  ' The names of each folder down to the one required separated
  ' by a character not used in folder names.
  ' ##############################################################
  ' Replace "Personal Folders|MailBox|Inbox" with the name
  ' of one of your folders.  If you use "|" in your folder names,
  ' pick a different separator and change the call of AnswerC2().
  ' ##############################################################
  FolderNameTgt = "Personal Folders|MailBox|Inbox"

  Call AnswerC2(FolderTgt, FolderNameTgt, "|")
  If FolderTgt Is Nothing Then
    Debug.Print FolderNameTgt & " not found"
  Else
    Debug.Print FolderNameTgt & " found: " & FolderTgt.Name
  End If

End Sub

Sub AnswerC2(ByRef FolderTgt As MAPIFolder, NameTgt As String, NameSep As String)

  ' This routine initialises the search and finds the top level folder

  Dim InxFolderCrnt As Integer
  Dim NameChild As String
  Dim NameCrnt As String
  Dim Pos As Integer
  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 AnswerC3() to look for its children
      Call AnswerC3(TopLvlFolderList.Item(InxFolderCrnt), _
                                            FolderTgt, NameChild, NameSep)
      Exit For
    End If
  Next

End Sub

Sub AnswerC3(FolderCrnt As MAPIFolder, ByRef FolderTgt As MAPIFolder, _
                                         NameTgt As String, NameSep As String)

  ' This routine finds all folders below the top level

  Dim InxFolderCrnt As Integer
  Dim NameChild As String
  Dim NameCrnt As String
  Dim Pos As Integer

  ' 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 AnswerC3(FolderCrnt.Folders(InxFolderCrnt), _
                                            FolderTgt, NameChild, NameSep)
      End If
      Exit For
    End If
  Next

End Sub

Examining a target folder

AnswerC2() and AnswerC3() provides the code to find a target folder. Folders contain items: mail items, meeting requests, contacts, calendar entries and more. Only mail items are examined by this code. Accessing meeting requests is essentially the same but they have different properties.

AnswerD() outputs a selection of a mail item's properties.

Once you have tried AnswerD() on a selection of folders, press F2 or, from the tool bar, select View, Object Browser. Scroll down the list of items until you reach MailItem. The members' area will display all its properties and methods of which there are in excess of 100. Some are pretty obvious; most you will have to look up in VB Help. Amend this routine to explore more properties and methods and, perhaps, other types of item.

Warning. This code is designed to look through a named folder for mail items. You may encounter problems if you amend the code to explore the entire folder hierarchy. It could have been my mistake or it could have been faults in the installation but I have found that my code crashes if I attempt to access certain folders such as "RSS Feeds". I have never been interested enough to explore these crashes and have simply amended my tree search to ignore branches with selected names.

When you run this macro, you will receive a warning: "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?" Tick "Allow access for", select an interval, and click Yes.

Sub AnswerD()

  Dim FolderItem As Object
  Dim FolderItemClass As Integer
  Dim FolderNameTgt As String
  Dim FolderTgt As MAPIFolder
  Dim InxAttach As Integer
  Dim InxItemCrnt As Integer

  ' ##############################################################
  ' Replace "Personal Folders|MailBox|Inbox" with the name
  ' of one of your folders.  If you use "|" in your folder names,
  ' pick a different separator and change the call of AnswerC2().
  ' ##############################################################
  FolderNameTgt = "Personal Folders|MailBox|Inbox"

  Call AnswerC2(FolderTgt, FolderNameTgt, "|")
  If FolderTgt Is Nothing Then
    Debug.Print FolderNameTgt & " not found"
  Else
    ' Display mail items, if any, within folder
    Debug.Print "Mail items within " & FolderNameTgt
    For InxItemCrnt = 1 To FolderTgt.Items.Count
      Set FolderItem = FolderTgt.Items.Item(InxItemCrnt)

      With FolderItem

        ' This code seems to avoid syncronisation errors
        FolderItemClass = 0
        On Error Resume Next
        FolderItemClass = .Class
        On Error GoTo 0

        If FolderItemClass = olMail Then
          ' Display Received date, Attachment count and Subject
          Debug.Print "  Mail item: " & InxItemCrnt
          Debug.Print "    Received=" & Format(.ReceivedTime, _
                      "ddmmmyy hh:mm:ss") & "  " & _
                      .Attachments.Count & _
                      " attachments  Subject = " & .Subject
          Debug.Print "    Sender: " & .SenderName
          With .Attachments
            ' If the are attachments display their types and names
            If .Count > 0 Then
              Debug.Print "    Attachments:"
              For InxAttach = 1 To .Count
                With .Item(InxAttach)
                  Debug.Print "       Type=";
                  Select Case .Type
                    Case olByReference
                      Debug.Print "ByRef";
                    Case olByValue
                      Debug.Print "ByVal";
                    Case olEmbeddeditem
                      Debug.Print "Embed";
                    Case olOLE
                      Debug.Print "  OLE";
                  End Select
                  Debug.Print "  DisplayName=" & .DisplayName
                End With
              Next
            End If
          End With
        End If
      End With
    Next InxItemCrnt
  End If

End Sub

Saving bodies to disc

AnswerE() finds a folder of your choice and saves a copy of the text and html bodies of every mail item within it. I suggest you copy a select of messages containing table to a new folder and run AnswerE(). This is not directly relevant to your questions but I believe it will aid understanding.

When you run this macro, you will receive a warning: "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?" Tick "Allow access for", select an interval, and click Yes.

Sub AnswerE()

  ' Output any Text or HTML bodies found within specified folder

  Dim FolderItem As Object
  Dim FolderItemClass As Integer
  Dim FolderNameTgt As String
  Dim FolderTgt As MAPIFolder
  Dim FileSystem As Object
  Dim FileSystemFile As Object
  Dim HTMLBody As String
  Dim InxAttach As Integer
  Dim InxItemCrnt As Integer
  Dim PathName As String
  Dim TextBody As String

  ' ##############################################################
  ' Replace "Personal Folders|MailBox|Inbox" with the name
  ' of one of your folders.  If you use "|" in your folder names,
  ' pick a different separator and change the call of AnswerC2().
  ' The folder you pick must have at least one mail item with an
  ' HTML body for this macro to do anything.
  ' ##############################################################
  FolderNameTgt = "Personal Folders|MailBox|Inbox"

  Call AnswerC2(FolderTgt, FolderNameTgt, "|")
  If FolderTgt Is Nothing Then
    Debug.Print FolderNameTgt & " not found"
    Exit Sub
  End If

  ' ####################################################################
  ' The following is an alternative method of accessing a default folder
  ' such as Inbox. This statement would replace the code above.
  ' Set FolderTgt = CreateObject("Outlook.Application"). _
  '            GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  ' ####################################################################

  ' Extract bodies if found

  Set FileSystem = CreateObject("Scripting.FileSystemObject")

  ' ##############################################################
  ' Replace "C:\Email\" with the name of one of your folders 
  ' ##############################################################
  PathName = "C:\Email\"

  For InxItemCrnt = 1 To FolderTgt.Items.Count
    Set FolderItem = FolderTgt.Items.Item(InxItemCrnt)

    With FolderItem

      ' This code seems to avoid syncronisation errors
      FolderItemClass = 0
      On Error Resume Next
      FolderItemClass = .Class
      On Error GoTo 0

      If FolderItemClass = olMail Then
        HTMLBody = Trim(.HTMLBody)
        If HTMLBody <> "" Then
          ' Save HTML body to disc.  The file name is of the form
          ' BodyNNN.html where NNN is a a sequence number.  
          ' First True in CreateTextFile => overwrite existing file.
          ' Second True => Unicode format
          Set FileSystemFile = FileSystem.CreateTextFile(PathName & _
                   "Body" & Right("00" & InxItemCrnt, 3) & _
                               ".html", True, True)
          FileSystemFile.Write HTMLBody
          FileSystemFile.Close
        End If
        TextBody = Trim(.Body)
        If HTMLBody <> "" Then
          ' Save text body to disc.  The file name is of the form
          ' BodyNNN.txt where NNN is a a sequence number.
          Set FileSystemFile = FileSystem.CreateTextFile(PathName & _
                   "Body" & Right("00" & InxItemCrnt, 3) & _
                               ".txt", True, True)
          FileSystemFile.Write TextBody
          FileSystemFile.Close
        End If
      End If
    End With

  Next InxItemCrnt

End Sub

Creating or updating an Excel workbook

You do not say if you will create a new Excel workbook or update an existing one. AnswerF1() creates a workbook. AnswerF2() opens an existing workbook.

Before trying either of these macros you must:

• From within the Outlook VBA Editor, select Tools from the toolbar.
• Select References.
• Scroll down to Microsoft Excel 11.0 Object Library and tick the box against it.

.

 Sub AnswerF1()

   Dim xlApp As Excel.Application
   Dim ExcelWkBk As Excel.Workbook
   Dim FileName As String
   Dim PathName As String

  ' ##############################################################
  ' Replace "C:\Email\" with the name of one of your folders
  ' Replace "MyWorkbook.xls" with the your name for the workbook
  ' ##############################################################
  PathName = "C:\Email\"
  FileName = "MyWorkbook.xls"

  Set xlApp = Application.CreateObject("Excel.Application")
  With xlApp
    .Visible = True         ' This slows your macro but helps during debugging
    Set ExcelWkBk = xlApp.Workbooks.Add
    With ExcelWkBk

      ' Add Excel VBA code to update workbook here

      .SaveAs FileName:=PathName & FileName
      .Close
    End With
    .Quit
  End With
End Sub
Sub AnswerF2()

  Dim xlApp As Excel.Application
  Dim ExcelWkBk As Excel.Workbook
  Dim FileName As String
  Dim PathName As String

  ' ##############################################################
  ' Replace "C:\Email\" with the name of one of your folders
  ' Replace "MyWorkbook.xls" with the your name for the workbook
  ' ##############################################################
  PathName = "C:\Email\"
  FileName = "MyWorkbook.xls"

  Set xlApp = Application.CreateObject("Excel.Application")
  With xlApp
    .Visible = True         ' This slows your macro but helps during debugging
    Set ExcelWkBk = xlApp.Workbooks.Open(PathName & FileName)
    With ExcelWkBk

      ' Add Excel VBA code to update workbook here

      .Save
      .Close
    End With
  End With
End Sub

Writing to the Excel workbook

This code finds the next free row in you workbook and writes to it. I explain why constants are useful and warn you about keeping your Outlook and Excel code apart.

' Constants allow you alter the sequence of columns in your workbook without
' having to change your code.  Replace the 1, 2 and 3 in these statements
' and the job is done.
' !!! Constants must be above any subroutines and functions.

Public Const ColFrom As Integer = 1
Public Const ColSubject As Integer = 2
Public Const ColSentDate As Integer = 3

Sub AnswerG()

  Dim RowNext As Integer

  ' This code goes at the top of your macro
  With Sheets("Sheet1")     '   Replace with the name of your worksheet
    ' This finds the bottom row with a value in column A.  It then adds 1 to get
    ' the number of the first unused row.
    RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
  End With

  ' You will have to separate your Outlook and Excel code.
  ' With Outlook
  '   Var1 = .Body
  '   Var2 = .ReceivedTime
  '   Var3 = .SenderName
  ' End With
  ' With Excel
  '   .Cell(R, C).Value = Var1
  ' End With

  With Sheets("Sheet1")     '   Replace with the name of your worksheet

    .Cells(RowNext, ColFrom).Value = "John Smith"
    .Cells(RowNext, ColSubject).Value = "Our meeting"
    With .Cells(RowNext, ColSentDate)
      .Value = Now()
      ' This format means the time is stored and I can access it but it
      'is not displayed.  Change to "mm/dd/yy" or whatever you like.
      .NumberFormat = "d mmm yy"
    End With
    RowNext = RowNext + 1   ' Ready for next loop

  End With

End Sub

Summary

I hope I have provided an appropriate level of detail. Please respond with a comment either way.

Don't leap to the final macros. If anything goes wrong you will not understand the cause. Take the time to play with each of the earlier answers. Amend them to do something slightly different.

Best of luck. You will be amazed how quickly you will become comfortable with Outlook and VBA.