Resources, Books, Tips, Links and more

Upgrade to the new Office 2003 and buy it now 
The new Office version allows you more programming control, especially when you are programming Outlook applications.

The following code reads e-mails from a folder in Outlook in to Excel file line by line. 

The key here, is the portion highlighted in Yellow
A little tip, when you record the code to process the e-mails in Excel and copy the code to Outlook add xlApp. in front. I highlighted an example below in Green. This stops error messages when you try to run the code for a second time.

Sub E-Mail_Reader()

subfolder_name ="Test_SubFolder"
folder_name      = "Test_Folder"
file_Location     = "d:\Documents and Settings\My Documents\Test_File.xls"
Sheet_Name     = "Sheet1"


' ****** goto the folder with the e-mails ***********
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myTestFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(folder_name)
Set myOlApp.ActiveExplorer.CurrentFolder = myTestFolder.Folders(subfolder_name)

' ****** open the Excel file ************
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Open(FileName:=file_Location)
xlApp.DisplayAlerts = False

' ****** open mail *****************
Dim oMailitem As MailItem
Dim oMailItems As Items, i As Long, j As Long
Mail_Counter = Application.ActiveExplorer.CurrentFolder.Items.Count

For j = 1 To Mail_Counter
        xlWB.Sheets(Sheet_Name).Select   ' ******** go to the Excel Sheet "Sheet1" ******
        Cells.Select
        Selection.ClearContents

       Set oMailitem = Application.ActiveExplorer.CurrentFolder.Items(j)
       strBody = oMailitem.Body
       strLine = Mid$(strBody, 1, InStr(strBody, vbCrLf) - 1)
       strBody = Mid$(strBody, InStr(strBody, vbCrLf) + 2)
       i = 1
       xlWB.ActiveSheet.Cells(i, 1).Value = strLine
       While Len(strBody)
               i = i + 1
               strLine = Mid$(strBody, 1, InStr(strBody, vbCrLf) - 1)
               xlWB.ActiveSheet.Cells(i, 1).Value = strLine
               strBody = Mid$(strBody, InStr(strBody, vbCrLf) + 2)
        Wend
' ********* Put you own code here to process the data and then move data to another place ******

'  xlApp.Worksheets("Sheet1").Activate
'  xlApp.Rows("1:1").Select
'  xlApp.Selection.Insert Shift:=xlDown
'  ...............................

' ********* Put you own code here to process the data and then move data to another place ******

Next J

' ******************* Save and close and release the resources *************
Set oMailitem = Nothing
Set oMailItems = Nothing

xlWB.Save
xlWB.Close
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing

Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myTestFolder = Nothing

End sub

Need a Dedicated Servers?

EatOutGoOut.com is hosted on a dedicated server from ServerBeach.com. 
If you are looking for a dedicated server to host your sites, then look no further then ServerBeach.com
They offer the newest Linux and Windows Servers with lots of Bandwidths.