Software

Quickly export Outlook e-mail items to Excel

Exporting e-mail messages from Outlook to Excel is easier than you might think. This sample VBA code automates the process, allowing you to specify exactly which fields to copy.

Office makes collaborating between applications easy, which is good news when you have data in one application but you need it in another. For instance, you might want to export a list of e-mail messages about a specific project, or from a specific person, to Excel for quick sorting, formatting, or more likely, to share with a non-Office application. The good news is that the process is simple to automate -- a bit of VBA code and a way to execute it gets the job done. (This article's sample code was written for Office 2003, but it should work as is or with minor adjustments in Office 2000 and 2002.)

Note: This information is also available as a PDF download, along with a BAS file containing the sample code.

Adding the export code

Working from Outlook, launch the Visual Basic Editor (VBE) by pressing Alt + F11. Choose Module from the Insert menu and enter the VBA code shown in Listing A. Next, reference the Excel object library. To do so, choose References from the Tools menu (while still in the VBE) and check Microsoft Excel 11.0 Object Library, as shown in Figure A. Then, click OK to return to the VBE.

Figure A: Update the library references to include Excel's object library.

object library

Listing A: ExportToExcel()

Sub ExportToExcel()
  On Error GoTo ErrHandler
  Dim appExcel As Excel.Application  Dim wkb As Excel.Workbook

Dim wks As Excel.Worksheet

Dim rng As Excel.Range

Dim strSheet As String

Dim strPath As String

Dim intRowCounter As Integer

Dim intColumnCounter As Integer

Dim msg As Outlook.MailItem

Dim nms As Outlook.NameSpace

Dim fld As Outlook.MAPIFolder

Dim itm As Object
    strSheet = "OutlookItems.xls"  strPath = "C:Examples\"

strSheet = strPath & strSheet

Debug.Print strSheet
  'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
  'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then

MsgBox "There are no mail messages to export", vbOKOnly, _

"Error"

Exit Sub

ElseIf fld.DefaultItemType <> olMailItem Then

MsgBox "There are no mail messages to export", vbOKOnly, _

"Error"

Exit Sub

ElseIf fld.Items.Count = 0 Then

MsgBox "There are no mail messages to export", vbOKOnly, _

"Error"

Exit Sub

End If
  'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")

appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook

Set wks = wkb.Sheets(1)

wks.Activate

appExcel.Application.Visible = True
  'Copy field items in mail folder.
For Each itm In fld.Items

intColumnCounter = 1

Set msg = itm

intRowCounter = intRowCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.To

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.SenderEmailAddress

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.Subject

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.SentOn

intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)

rng.Value = msg.ReceivedTime

Next itm
  Set appExcel = Nothing  Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing
  Exit Sub
ErrHandler:  If Err.Number = 1004 Then

MsgBox strSheet & " doesn't exist", vbOKOnly, _

"Error"

Else

MsgBox Err.Number & "; Description: ", vbOKOnly, _

"Error"

End If

Set appExcel = Nothing

Set wkb = Nothing

Set wks = Nothing

Set rng = Nothing

Set msg = Nothing

Set nms = Nothing

Set fld = Nothing

Set itm = Nothing
End Sub

Using the code to export

To execute the code, position the cursor inside the procedure and press F5. Instruct your users to choose Macro from the Tools menu (inside Outlook), select Macros, select ExportToExcel in the resulting dialog box, and click Run. If they use this technique often, consider adding a button to the toolbar.

After declaring a few variables, the code displays the Select Folder dialog shown in Figure B.

Figure B: Select the folder that contains the messages you want to export.

selecting a folder

Select a folder and click OK. Next, the code handles the following potential errors:

  • The user clicks Cancel to close the Select Folder dialog box.
  • The user selects a non-mail folder
  • The mail folder contains no mail items

Then, the code identifies and opens an Excel workbook. In this sample code, the workbook must exist. You should update this code to accommodate your system and Excel workbook. This is also a good spot for further automating the technique by allowing users to select an existing workbook or to create a new one. For our purposes, hard coding the workbook simplifies the process.

The For Each loop is the heart of this exporting technique. There are two counters, intRowCounter and intColumnCounter. As the code inserts field values from the current message, the code updates intColumnCounter. Once the code has inserted all of the current message items, it updates intRowCounter. Without these counters, the code would write over each value in A1.

The code now inserts the first field item in A1. You can offset that by specifying a starting value for one or both counters to allow for headers or to append records instead of writing over existing values. In addition, this sample code copies only a few fields: To, SenderEmailAddress, Subject, SentOn, and ReceivedTime, as shown in Figure C.

Figure C: The macro has copied the items in the specified folder to Excel.

exported messages

You can add as many fields as you need. Just be sure to include a column update statement for each field you want to copy. For instance, if you want to export the actual message text, you can add the following code:

    Set rng = wks.Cells(intRowCounter, intColumnCounter)    rng.Value = msg.Body
intColumnCounter = intColumnCounter + 1

Note that this process doesn't transfer all the characters perfectly. You might see a few phantom characters in your Excel workbook. Also, keep in mind that the code doesn't do any formatting -- you'll have to adjust column widths and so on manually or add code to take care of the task.

If you notice that a specific field generates an error if the field is empty, use an If statement in the form:

If msg.field <> "" Then rng.Value = msg.field

to handle that error. None of the fields in the sample code poses a problem if the field is empty. The code simply leaves the appropriate cell in Excel blank.

After the Next statement and before setting all the object variables to Nothing, you might want to add code that handles the open Excel workbook in some way. For instance, you might save it and then close it.

The error handling routine is generic and simple. Be sure to test this code thoroughly and enhance it accordingly.


Susan Sales Harkins is an independent consultant and the author of several articles and books on database technologies. Her most recent book is Mastering Microsoft SQL Server 2005 Express, with Mike Gunderloy, published by Sybex. Other collaborations with Gunderloy are Automating Microsoft Access 2003 with VBA, Upgrader's Guide to Microsoft Office System 2003, ICDL Exam Cram 2, and Absolute Beginner's Guide to Microsoft Access 2003, all published by Que. Currently, Susan volunteers as the Publications Director for Database Advisors. You can reach her at ssharkins@gmail.com.

About

Susan Sales Harkins is an IT consultant, specializing in desktop solutions. Previously, she was editor in chief for The Cobb Group, the world's largest publisher of technical journals.

88 comments
munchietjunk
munchietjunk

How do you only download messages 2 weeks back from current date?

anilmega99
anilmega99

Hi how to extract for Modified date data ?

crazyhorse50
crazyhorse50

Sorted out getting the correct references for outlook and with Some more poking around and I find that set fld = nms.PickFolder giving error 438. even though the set nms=application.GetNamespace("MAPI") executed the locals window says that nms value is nothing.

crazyhorse50
crazyhorse50

I am not very good at VBS and usually rely on recording and then fixing the resultant code.. something I can do here! I downloaded the code and tried to execute it but got an error on the statements Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder all give Compile error -- User-defined type not defined. Is it something blindly obvious I tried including a tool reference to "Microsoft Office Outlook View Control" and "Microsoft Office 12.0 Object library" Which made the macro run but gave and error "438; Description:" with no description but according to Mr Google is "Excel VBA, error 438 'object doesn't support this property or method'" So perhaps teh ssissue is more fundamantal./ Help! Philip

jitheshkn
jitheshkn

Please help me out. I copied the code into my VBE Moduel for outlook but unable to Eecute it ..

Honey0201
Honey0201

Thank you for a great macro.IT works weel. How do i insert a query to get the attachments along with this query.Please suggest,as i am new to VBA.

schmud77
schmud77

Please help me out. I copied the code into my VBE Moduel for outlook. When I try to run F5 I get the error User-Defined Type Not Defined The following code is highlighted appExcel As Excel.Application I am using the following versions Outlook 2003 SP3 Excel 2010 Version 14.0.6112.5000 (32bit) I followed the pdf directions up to trying to run. I chose Microsoft Excel 11.0 Object Library, Please help me out

Giunca
Giunca

Do you know of a simple way of dragging and dropping (or otherwise quickly creating) a link to an individual outlook email into and Excel Spreadsheet? Right now when you drag an email into excel, it puts information about the email into a small table. What I would like to do is drag an email and have it creat a link to that email. Make sense?

kalrek
kalrek

I have put pasted the code in and followed the instructions, my code is failing on this line the only things i have added to the code is the location of the xml and the directory, If msg.field "" Then rng.Value = msg.field If i take that line away and press f5 i get 438 decription, i am using office 2010 and excel2007 Please help really need this. thanks so much

firozkhanpathan
firozkhanpathan

hey guyz, whats the difference btw "import/export' option from out look and the VBA code that we are discussing in this forum. I did try with the option from outlook and that resulted into an excel sheet with the from, to, subject information. however, the body matter was consolidated into a single cell, rather than inputting the queries answer in different cells based on the question. some how the codes mentioned in the forum is not helpful.. any suggestions ?

Bicu
Bicu

How can i automate the folder selection. I want to assign this code to a script that will run everytime a new message comes in and don't want to have to select the folder everytime. Any Suggestions?

nidhi.malhotra25
nidhi.malhotra25

Hi i have tried to use the macro but its not working for Outlook 2010...can you please help ASAP....i have to transfer data from 1020 emails body text......

Inkwizita
Inkwizita

I've amended the base code slightly to point to my own spreadsheet. To remove an error regarding blank subjects and to add in BODY text. However everythnig works perfectly if i run the code once, if i try to run it a second time i get a err 462 message. I've looked online and solutions range around child - parent ordering of the Set *** = Nothing commands so i've reordered them into child - parent order. However i still can't run the code a second time. Anyone got any ideas This is my code Sub ExportToExcelAdAlertArchive() On Error GoTo ErrHandler Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim intRowCounter As Integer Dim intColumnCounter As Integer Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder Dim itm As Object strSheet = "AdAlertArchive.xls" strPath = "P:\CustomerSecurity\CUSTOMER SECURITY\Tony Simpson\EmailExtracts\" strSheet = strPath & strSheet Debug.Print strSheet 'Select export folder Set nms = Application.GetNamespace("MAPI") Set fld = nms.PickFolder 'Handle potential errors with Select Folder dialog box. If fld Is Nothing Then MsgBox "There are no mail messages to export", vbOKOnly, "Error" Exit Sub ElseIf fld.DefaultItemType olMailItem Then MsgBox "There are no mail messages to export", vbOKOnly, "Error" Exit Sub ElseIf fld.Items.Count = 0 Then MsgBox "There are no mail messages to export", vbOKOnly, "Error" Exit Sub End If ' 'Open and activate Excel workbook. 'Set appExcel = CreateObject("Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'Copy field items in mail folder. For Each itm In fld.Items intColumnCounter = 1 Set msg = itm intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.To intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SenderEmailAddress intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) If msg.Subject "" Then rng.Value = msg.Subject intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SentOn intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.ReceivedTime Next itm wkb.Save wkb.Close Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing Set wks = Nothing Set wkb = Nothing Set appExcel = Nothing Exit Sub ErrHandler: If Err.Number = 1004 Then MsgBox strSheet & " doesn't exist", vbOKOnly, "Error" Else MsgBox Err.Number & "; Description: ", vbOKOnly, "Error" End If Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing Set wks = Nothing Set wkb = Nothing Set appExcel = Nothing End Sub

Reeve99
Reeve99

I have big use of this code you have written. And I did implement the msg.Body value. And I also implemented a function to retrieve a specifik word in the body. But I need words on the other lines to, how should I do? The code is as follows. --- Set rng = wks.Cells(i, j) rng.Value = MyExtract(msg.Body, 2, "F", " ") j = j + 1 ---- Function MyExtract(MyText As String, ItemNo As Integer, FrontOrBack As String, Optional MySeparator As String) As String Dim LenText As Integer, n As Integer, CountSpaces As Integer Dim MySt As Integer, MyFin As Integer, MyStep As Integer, Mk1 As Integer, Mk2 As Integer ' MySeparator was an optional parameter If Len(MySeparator) = 0 Then MySeparator = " " LenText = Len(MyText) ' You cannot extract a word if length is LT 3 chars If LenText < 3 Then MyExtract = "*" GoTo MyEndBit End If ' set the direction in which the text is examined If UCase(FrontOrBack) = "F" Then MySt = 2 MyFin = LenText - 1 MyStep = 1 Else MyFin = 2 MySt = LenText - 1 MyStep = -1 End If ' identify the position of characters matching the separator For n = MySt To MyFin Step MyStep If Mid(MyText, n, 1) = MySeparator Then CountSpaces = CountSpaces + 1 If CountSpaces = ItemNo - 1 Then Mk1 = n If CountSpaces = ItemNo Then Mk2 = n End If Next n If CountSpaces = 0 Then MyExtract = "*" GoTo MyEndBit End If If UCase(FrontOrBack) = "B" Then n = Mk1 Mk1 = Mk2 Mk2 = n End If If Mk2 = 0 Then Mk2 = LenText + 1 Mk1 = Mk1 + 1 MyExtract = Mid(MyText, Mk1, Mk2 - Mk1) MyEndBit: End Function

jacobnelik
jacobnelik

This marco works very well. I am trying to include a code for one (same) cell in each row, where if a specific string is part of the text content, it should be removed. The REPLACE command partially works: When the string (that I am looking for) is not in the cell, it pauses with Microsoft message that there is no string to replace. The Microsoft error message also states that if the sheet is protected it can't replace. Once I hit the space bar it continues to the next row. Can someone provide example of a solution to this issue? Thank you very much.

typeundefined
typeundefined

Hi, I used this code and it works perfectly. I need help on adding a part to this code. How can highlight a row in excel if the subject of the email starts with 'Re: *'?? Basically, my end goal is to highlight (in excel) the emails that have been replied to. Please help...i'm not good with vba

PaoloMauro
PaoloMauro

Hi code works, but it only returns 64 lines then shows this error "13;description". Any idea what this means? I would expect several thousand results, not only 64

Ttomyj14
Ttomyj14

Im getting error like few others above me after I export "file doesnt exist example.xls" error. Please help.

Yeoh88
Yeoh88

Hi all, I am a newbie in VBA and macro. I recently found out that VBA and macro can do wonders. I will be receiving email with same subject name and format everyday. what i will normally do is opening my outlook and search for that email, using 'Ctrl + A' and 'Ctrl +C' to copy everything(because the data is kind of lenghty) and open an excel and paste it in and save it. that will automatically update in my macro in excel. but this gv me alot of troubles because i got alot of emails to go through. it will be great is VBA and macro can do this automatically for me everyday. i only wanted it to have the normal copy paste function and not inserting the whole email body to 1 small column. Since i am new in programming, step by step instructions will be needed. Thanks for reading my post and hope to get some reply soon. Good Day. i am currently using microsoft office 2007. Best Regards, SarahYeoh

MegaMonsterMike
MegaMonsterMike

What does the code look like if I wanted to create an Excel file instead of trying to find one that already exists? For some reason I keep getting "Error" and my file "doesn't exist"

Gran Ariete
Gran Ariete

I used this code in MSO 2010 and this macro's perfectly functional. Thanks a lot Susan.

deadradio
deadradio

okay i used this code and it take the email to excel which is great, gives date, sender, etc, and i added the body code to pull the body info from the email, however the emails im using are almost like a form and they break down customer info. How do i program this to separate each field into excel? Right now it pulls all the body info in one cell which is impossible to separate the data quickly. here is the way i have the code and how my emails look when they come over. Option Explicit Sub ExportToExcel() On Error GoTo ErrHandler Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim intRowCounter As Integer Dim intColumnCounter As Integer Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder Dim itm As Object strSheet = "OutlookItems.xls" strPath = "C:\Examples\" strSheet = strPath & strSheet Debug.Print strSheet 'Select export folder Set nms = Application.GetNamespace("MAPI") Set fld = nms.PickFolder 'Handle potential errors with Select Folder dialog box. If fld Is Nothing Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.DefaultItemType olMailItem Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.Items.Count = 0 Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub End If 'Open and activate Excel workbook. Set appExcel = CreateObject("Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'Copy field items in mail folder. For Each itm In fld.Items intColumnCounter = 1 Set msg = itm intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.To intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SenderEmailAddress intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Subject intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SentOn intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Body Next itm Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Body Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Body intColumnCounter = intColumnCounter + 1 intColumnCounter = intColumnCounter + 1 If msg.field "" Then rng.Value = msg.field Exit Sub ErrHandler: If Err.Number = 1004 Then MsgBox strSheet & " doesn't exist", vbOKOnly, _ "Error" Else MsgBox Err.Number & "; Description: ", vbOKOnly, _ "Error" End If Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing End Sub Here is an example of the info i get in the email Customer Name: John Do Day Phone: 606 555-1212 Evening Phone: 606-555-1212 Best Time to Call: 10 a.m - 12 p.m. Email: thinkle3991232324@newwavecomm.net Street Address: 16545343 Super Fake Hollow Rd. State: Kentucky City: Corbin ZIP: 40701 Credit Profile: good Loan Purpose: Debt Consolidation Desired Loan Amount: 220000 Estimated Home Value: 260000 Type of Home: Single Family Current Mortgage Balance: 186000 Current Interest Rate: 5.75 2nd Mortgage Balance: 0 2nd Mortgage Rate: 0 Debt Type: My Credit Card Debt Amount Of Debt: $20,000 - $25,000 Sales ID:

MegaMonsterMike
MegaMonsterMike

Why would I get an Error like that? I created the folder and file. I know it "exists" because I can open and save to it... but for some reason when I run the code I get the Error message. Any ideas? I'm on a work computer if that matters... but I even tried saving to my local drive and I still get the error. I'm stumped!

lunasea
lunasea

I had no problem a year ago using this great macro. Now I'm going nuts with a previously stated problem by somebody else:"I get this all working fine in Outlook 2007 up until the part where it chooses the strSheet - I have indeed created either a named .xlsx or .xls sheet. The application executes then returns an error that the path & sheet don't exist...and they do. Any ideas? " he said he solved it by "re-editing". What did he do?

powergear
powergear

Hi, I got your code complied, but when i run, its giving an error "Error 91 ; Description:", any help on this will be greatly appreciated.

carloschiari
carloschiari

Hi: Using this solution made me met with the 50290 error, which halted the script execution on a random basis, preventing Outlook to export the whole folder list. To fix it, I inserted the following code BEFORE each "rng.Value = .... " line: While appExcel.Ready = False [empty] Wend It prevented Outlook from failing when trying to contact Excel when Excel is not available. It fixed - for now - the problem for me.

carloschiari
carloschiari

Amazing! Thanks for this script. It worked with some minor personalizations as a charm! Also provided good insight for deeper learning!

justtalk
justtalk

This is a great macro. I am new to VB and this really helped. Thank you ! I have a lot of problem with security warning when I try to read the email body from excel. Using this macro I can achieve the same from Outlook and bypass the security issue.

edward.tse
edward.tse

I am using EasyExportMail (part of EncoreSuite). They can export attachment as well. I love it.

Alex1672
Alex1672

It's a great macro, and it works well for me, except when there are non-regular mail items, such as appointments, or discussion items. How would I have to adapt this code to use it with discussion items (from a public folder)? These discussion items are really only mail messages, but they have a different tag... Thank you!!

Arcoden
Arcoden

I like the code, but can't figure out how to make it work for Undeliverable notifications. I get a "Type Mismatch" at the "Set msg = itm" statement. I tried bypassing this statement and using itm rather than msg, but the itm object doesn't contain To or Sender properties. Any ideas?

DGoofy
DGoofy

Thanks for the code. It works fine though when I run it, it does not export all items from the Inbox. for example, I have 471 items in the Inbox but it exports only 191 of them!! Any idea what might be the problem??

kumarapush
kumarapush

@munchietjunk  To specify the date you can use the code in my reply and insert a if condition to compare the mail received date against a specific date (2 weeks back date). Insert this IF condition just before the code writes the mail to Excel sheet.

wizard57m-cnet
wizard57m-cnet

Rather than adding to the end of an old discussion. The 'Discussion' forum is for matters of general discussion, not specific problems in search of a solution. The 'Water Cooler' is for non-technical discussions. You can submit a question to 'Q&A' here: http://www.techrepublic.com/forum/questions/post?tag=mantle_skin;content There are TR members who specifically seek out problems in need of a solution. Although there is some overlap between the forums, you'll find more of those members in 'Q&A' than in 'Discussions' or 'Water Cooler'. Be sure to use the voting buttons to provide your feedback. Voting a '+' does not necessarily mean that a given response contained the complete solution to your problem, but that it served to guide you toward it. This is intended to serve as an aid to those who may in the future have a problem similar to yours. If they have a ready source of reference available, perhaps won't need to repeat questions previously asked and answered. If a post did contain the solution to your problem, you can also close the question by marking the helpful post as "The Answer".

ssharkins
ssharkins

I think it might be easier to use rules to download the mail into a specific folder and then send mail in that folder to a specific row.

Inkwizita
Inkwizita

I had similar issue, it seems to be to do with blank fields or fields with non standard text at the start for me i used this as a workaround. If msg.Subject "" Then rng.Value = msg.Subject This prevented blank subjects from causing the code to fail

Cearon
Cearon

I am getting it when a calendar request is found. Removing the offending item resolves this but am not able to find any code to resolve this, sorry vba not my thing at all

jhansen_analyst
jhansen_analyst

Is there a way to make this work for rss feed items? I'm not sure if it is a problem with referencing, but I have enabled the Microsoft Feeds as well as all other references mentioned above. I have also narrowed down where the code stops, but don't understand VBA enough to go any further. When I run the macro (with "ErrHandler" disabled), I get to this line in the code... " Set msg = itm" Please Help!

firozkhanpathan
firozkhanpathan

Can you please share the code that you have used, that was successful.. Thanks in advance !

funhawke
funhawke

That is what I am also trying to do with a similar form response - did you have any success with anything that worked for you?

ssharkins
ssharkins

Well, the only reason that comes to mind is that the path you've entered isn't correct. The first thing I'd do is check the path for typos.

ssharkins
ssharkins

I have no idea what the problem might be -- that is an odd one. Is it the first 191 messages?

DGoofy
DGoofy

Yes they are the first 191 messages (the oldest by looking at the date). I tried different code and it worked just fine. It exported all messages. but I'm curious, what might cause the problem in the old code?!! The new code that I used: Option Explicit Private strTemplatesPath As String Sub SaveMessagesToExcel() On Error GoTo ErrorHandler Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim i As Integer Dim j As Integer Dim lngCount As Long Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder 'Must declare as Object because folders may contain different 'types of items Dim itm As Object Dim strTitle As String Dim strPrompt As String strPath = "C:\" strSheet = "Messages.xls" strSheet = strPath & strSheet Debug.Print "Excel workbook: " & strSheet Set appExcel = GetObject(, "Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'Let user select a folder to export Set nms = Application.GetNamespace("MAPI") Set fld = nms.PickFolder If fld Is Nothing Then GoTo ErrorHandlerExit End If 'Test whether selected folder contains mail messages If fld.DefaultItemType olMailItem Then MsgBox "Folder does not contain mail messages" GoTo ErrorHandlerExit End If lngCount = fld.Items.Count If lngCount = 0 Then MsgBox "No messages to export" GoTo ErrorHandlerExit Else Debug.Print lngCount & " messages to export" End If 'Adjust i (row number) to be 1 less than the number of the first body row i = 3 'Iterate through contact items in Contacts folder, and export a few fields 'from each item to a row in the Contacts worksheet For Each itm In fld.Items If itm.Class = olMail Then 'Process item only if it is a mail item Set msg = itm i = i + 1 'j is the column number j = 1 Set rng = wks.Cells(i, j) If msg.SenderName "" Then rng.Value = msg.SenderName j = j + 1 Set rng = wks.Cells(i, j) If msg.cc "" Then rng.Value = msg.cc j = j + 1 Set rng = wks.Cells(i, j) If msg.Subject "" Then rng.Value = msg.Subject j = j + 1 Set rng = wks.Cells(i, j) rng.Value = msg.ReceivedTime j = j + 1 Set rng = wks.Cells(i, j) On Error Resume Next 'The next line illustrates the syntax for referencing 'a custom Outlook field If msg.UserProperties("CustomField") "" Then rng.Value = msg.UserProperties("CustomField") End If j = j + 1 End If Next itm ErrorHandlerExit: Exit Sub ErrorHandler: If Err.Number = 429 Then 'Application object is not set by GetObject; use CreateObject instead If appExcel Is Nothing Then Set appExcel = CreateObject("Excel.Application") Resume Next End If Else MsgBox "Error No: " & Err.Number & "; Description: " Resume ErrorHandlerExit End If End Sub Public Function TestFileExists(strFile As String) As Boolean 'Created by Helen Feddema 9-1-2004 'Last modified 9-1-2004 'Tests for existing of a file, using the FileSystemObject Dim fso As New Scripting.FileSystemObject Dim fil As Scripting.File On Error Resume Next Set fil = fso.GetFile(strFile) If fil Is Nothing Then TestFileExists = False Else TestFileExists = True End If End Function

madocs
madocs

strSheet = "OutlookItems"

MegaMonsterMike
MegaMonsterMike

I copied the code from the bin file and I don't see any curly quotes. Maybe there is a way to just create a file instead of trying to find one?

MegaMonsterMike
MegaMonsterMike

I went to the file's Properties, then Location, and it shows "C:\Examples" The code I used is pasted below. I just copy/pasted from the bin file. I wish I could provide more info about what the Error is but it simply states "C:\Examples\OutlookItems.xls doesn't exist" with an OK button Sub ExportToExcel() On Error GoTo ErrHandler Dim appExcel As Excel.Application Dim wkb As Excel.Workbook Dim wks As Excel.Worksheet Dim rng As Excel.Range Dim strSheet As String Dim strPath As String Dim intRowCounter As Integer Dim intColumnCounter As Integer Dim msg As Outlook.MailItem Dim nms As Outlook.NameSpace Dim fld As Outlook.MAPIFolder Dim itm As Object strSheet = "OutlookItems.xls" strPath = "C:\Examples\" strSheet = strPath & strSheet Debug.Print strSheet 'Select export folder Set nms = Application.GetNamespace("MAPI") Set fld = nms.PickFolder 'Handle potential errors with Select Folder dialog box. If fld Is Nothing Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.DefaultItemType olMailItem Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub ElseIf fld.Items.Count = 0 Then MsgBox "There are no mail messages to export", vbOKOnly, _ "Error" Exit Sub End If 'Open and activate Excel workbook. Set appExcel = CreateObject("Excel.Application") appExcel.Workbooks.Open (strSheet) Set wkb = appExcel.ActiveWorkbook Set wks = wkb.Sheets(1) wks.Activate appExcel.Application.Visible = True 'Copy field items in mail folder. For Each itm In fld.Items intColumnCounter = 1 Set msg = itm intRowCounter = intRowCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.To intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SenderEmailAddress intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Subject intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.SentOn intColumnCounter = intColumnCounter + 1 Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.ReceivedTime Set rng = wks.Cells(intRowCounter, intColumnCounter) rng.Value = msg.Body intColumnCounter = intColumnCounter + 1 Next itm Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing Exit Sub ErrHandler: If Err.Number = 1004 Then MsgBox strSheet & " doesn't exist", vbOKOnly, _ "Error" Else MsgBox Err.Number & "; Description: ", vbOKOnly, _ "Error" End If Set appExcel = Nothing Set wkb = Nothing Set wks = Nothing Set rng = Nothing Set msg = Nothing Set nms = Nothing Set fld = Nothing Set itm = Nothing End Sub

ssharkins
ssharkins

Just thought of something, if you copied the code from the web page, check the string delimiters around the file name and paths. If they're curly quotes, replace them with straight quotes.

ssharkins
ssharkins

Open Windows Explorer and navigate to the example file. Copy the entire path from the address control into your code. If it still fails, post the entire statement--maybe something will shout out.

Bhavana Joshi
Bhavana Joshi

ANyone can HELP me what changes I need to make to Export Lotus 1-2-3 email items to excel instead of outlook. bhavana