Outlook 2003 --> Excel 2003 data export

[brunette]

Hi there,

I'm hoping that you can, once again, help me out with a project I've been asked to work on.

Every day, multiple times a day, I receive an email containing data that I have now been asked to quantify and chart, using Excel. Due to the large amounts of emails I receive daily, it's incrediby daunting to think that I'd have to copy/paste this info manually, then clean it up and work it in Excel.

I've had a look at various bits of VBA code here on the forum that can automate this task for me but none of them seem to work as I have a few hiccups that might be hindering the code from executing properly and my knowledge of tweaking code is, at best, awkward still. I seem to have messed things up more than fixed them so far :/

* Our company has created several mailboxes using MS Exchange. Along with my own exchange email account, I have access to one other mailbox. The info I need to pull off Outlook and into Excel is in this mailbox and not my own. I am not sure if this will be a problem or not.

* The information I need to export is not in the inbox but in a sub-folder called "Mensajeria".

Thanks in advance for your help. Preventing me from falling asleep while copy/pasting hundreds of emails one-by-one into Excel makes me VERY grateful! :D
Bru

 

[brunette]

Okay, I've found exactly what I am looking for....but I need help with tweaking it a bit. Every time I change something it goes wonky.

Current code that I got from elsewhere here on the forum (http://www.mrexcel.com/forum/showthread.php?t=532389&highlight=export+outlook+data+excel):

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 = "exceltest.xls"
    strPath = "C:\Documents and Settings\2840\Desktop\"
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
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
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

Ok, as I said, the above code works perfectly, except for:

1) It always returns this "There are no mail messages to export" error, even when there are mails to export and it exports them anyway.

2)

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

This returns: /O=ARGENA/OU=EX2/CN=RECIPIENTS/CN=036 and not an email address, so I can't sort by recipient. Can I fix it to show me an email address or alternatively show the name of the sender (.Sentfrom??)? I've tried to edit the line but it errors out so I'm clearly doing something wrong but I can't see what.

3) I need to include the body of the email - or at least parts of it (I know this causes a lot of "garbage" but I guess that phase 2 of this exercise will be to try to either clean it up or find a way of having the macro read only the relevant bits of data I need and filter only that into the spreadsheet..?

I'm happy to work with anyone who is willing to lend me a helping hand on this? I just need a light to show me way.

Thanks again!
Bru

 

[brunette]

Morning folks,

Sorry to press but, anyone out there that can lend me a hand on this please?

Thanks in advance,
Bru