Sending Email Data to Excel

[enrique63]

I'm trying to capture email data into an excel spreadsheet from an email confirmation sent to me from a website form, which are then saved in a separate outlook folder (& separate PST data file). The emails all come in the same format:

Header:
Subject: Online Training

Body:
First name: DANIEL
Last name: MILLER
Employee ID: 123456
Comments:
Course Code: _1min_obesity

What VBA would I use to automatically and regularly send the above information from each email to an excel spreadsheet (avoiding duplication), preferably with one row per email and 6 columns for the data.

Thanks!

[enrique63]

I've adapted VBA from another website and the macro is now 1) asking me to choose a folder, then 2) exporting the email data of messages flagged with a red icon to an excel spreadsheet called OutlookItems.xls on my desktop.

There are a couple of things I'd like to do but having trouble with the VBA language:

1) I only want emails with a red flag to be exported, and once it's exported, I want the flag removed. This is to prevent duplicate email data being sent.

2) When sending the email data to excel, how do I add to the data already there, instead of writing over it. Is it possible to add some instuctions after the worksheet.activate line?


' Quickly export Outlook e-mail items to Excel
' Written by Susan Harkin
' http://blogs.techrepublic.com.com/msoffice/?p=744&tag=content;leftCol

Sub FlagToExcel()
Dim appExcel As Excel.Application
Dim Workbook As Excel.Workbook
Dim Worksheet As Excel.Worksheet
Dim Range 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 NameSpace As Outlook.NameSpace
Dim Fld As Outlook.MAPIFolder
Dim itm As Object

On Error GoTo ErrHandler
strSheet = "OutlookItems.xls"
strPath = "C:\Documents and Settings\HP_Administrator\Desktop\"
strSheet = strPath & strSheet
Debug.Print strSheet
'Select export folder
Set NameSpace = Application.GetNamespace("MAPI")
Set Fld = NameSpace.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 Workbook = appExcel.ActiveWorkbook
Set Worksheet = Workbook.Sheets(1)
Worksheet.Activate
appExcel.Application.Visible = True
'Copy field items in mail folder.
For Each itm In Fld.Items

If Msg.FlagIcon = olRedFlagIcon Then

intColumnCounter = 1
Set Msg = itm
intRowCounter = intRowCounter + 1

Set Range = Worksheet.Cells(intRowCounter, intColumnCounter)
Range.Value = Msg.Subject
intColumnCounter = intColumnCounter + 1

Set Range = Worksheet.Cells(intRowCounter, intColumnCounter)
Range.Value = Msg.Body
intColumnCounter = intColumnCounter + 1

Set Range = Worksheet.Cells(intRowCounter, intColumnCounter)
Range.Value = Msg.SentOn
intColumnCounter = intColumnCounter + 1

End If
Next itm

Set appExcel = Nothing
Set Workbook = Nothing
Set Worksheet = Nothing
Set Range = Nothing
Set Msg = Nothing
Set NameSpace = 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 Workbook = Nothing
Set Worksheet = Nothing
Set Range = Nothing
Set Msg = Nothing
Set NameSpace = Nothing
Set Fld = Nothing
Set itm = Nothing
End Sub

[MarkCBB]

Hi There,

I was trying to use this code in my excel sheet, but i get the follwing error "Complie error User-defined type not defined"
is there any chance you can send me a working file to test on myside?
Thanks so much