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.
