rrtts
01-31-2007, 02:29 PM
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.
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
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.
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