Copy Outlook data to Excel

[rrtts]

I guess this could get posted in the Outlook thread, but since I am trying to use the data in Excel, I posted it here.

What I'm trying to do is create a macro that will copy the header information (From/Subject/Received) from all email in an Outlook folder and paste it in Excel.

If I click my Inbox, click View and select all, copy and paste this into a worksheet, I get the headers From, Subject, and Received" and then a list of all the emails. This is the result that I want but now I'm trying to figure out a macro to do this. I can't use excel's macro recorder because once I switch to Outlook it doesn't record that.

I searched and found a similar thread that had the below macro that I was going to try and modify but it apparently doesn't work.

Any ideas? Thanks.

---
Create a Workbook with a sheet with whatever name you want (I used C:\MyWorkbook.xls). Set up the following headers:
Sent On, To, CC, BCC, Subject, Body
Then open Outlook, and ensure Tools/Macros/Security is set to Medium (to allow the macro to run). Then depress Alt-F11 to get to Outlook VBA. Now, copy/paste this code.

[vba]
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objExcel As New Excel.Application
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim nRow As Integer
Const OutputFile = "C:\MyWorkbook.xls"
' Open file and set objects
objExcel.Workbooks.Open OutputFile
Set objWB = objExcel.Workbooks(1)
Set objWS = objWB.Sheets(1)
' Find the next available row
For nRow = 1 To 32767
If objWS.Range("A" & nRow).Value = "" Then Exit For
Next
' Insert data
Dim a As MailItem
objWS.Range("A" & nRow).Value = Item.LastModificationTime ' Used because SentOn isn't set yet
objWS.Range("B" & nRow).Value = Item.To
objWS.Range("C" & nRow).Value = Item.CC
objWS.Range("D" & nRow).Value = Item.BCC
objWS.Range("E" & nRow).Value = Item.Subject
objWS.Range("F" & nRow).Value = Item.Body
objWB.Save
objWB.Close
' Cleanup
Set objWS = Nothing
Set objWB = Nothing
Set objExcel = Nothing
End Sub
[/vba]

[clvestin]

Perhaps a little off the mark, but here's a routine that writes to the immediate window.

[VBA]Private Sub Main()
Dim MyNS As NameSpace
Set MyNS = Application.GetNamespace("MAPI")
Dim fldFolder As MAPIFolder
Set fldFolder = MyNS.folders("Mailbox - blow,joe")
Call GetFolderInfo(fldFolder)
End Sub
Private Sub GetFolderInfo(fldFolder As MAPIFolder)
' This procedure prints to the Immediate window information
' about items contained in a folder.
Dim objItem As Object
Dim dteCreateDate As Date
Dim strSubject As String
Dim strItemType As String
Dim intCounter As Integer
On Error Resume Next
If fldFolder.folders.Count > 0 Then
For Each objItem In fldFolder.folders
Call GetFolderInfo(objItem) ' How the recursiveness works down the branches of the tree.
Next objItem
End If
Debug.Print "Folder '" & fldFolder.Name & "' (Contains " _
& fldFolder.Items.Count & " items):"
For Each objItem In fldFolder.Items
intCounter = intCounter + 1
With objItem
dteCreateDate = .CreationTime
strSubject = .Subject
strItemType = TypeName(objItem)
End With
Debug.Print vbTab & "Item #" & intCounter & " - " _
& strItemType & " - created on " _
& Format(dteCreateDate, "mmmm dd, yyyy hh:mm am/pm") _
& vbCrLf & vbTab & vbTab & "Subject: '" _
& strSubject & "'" & vbCrLf
Next objItem
End Sub[/VBA]

[rrtts]

Where does this go and how does it work...I think it goes in Outlook...but can't seem to get it to work.

[clvestin]

Yes-this works from Outlook. I think the problem might be in the line[VBA]Dim fldFolder As MAPIFolder
Set fldFolder = MyNS.folders("Mailbox - blow,joe")
[/VBA]
I can't find the original file ,but the folder name needs to be played with, ie substitue one of your folders.

[rrtts]

yeah...I tried that...no joy...back to the drawing board...thanks for the help though.

[rrtts]

Searching thru the archives here (what a great thing)...I found code submitted by Ken Puls and Killian from a few years ago for someone trying to do something similar. I was able to edit it and make it work.

[matthewspatrick]

Please post the code you got to work, and mark the thread as solved