Outlook Technologies

Outlook Forms

Languages

Samples

More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 09-Sep-2010 06:08

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: intermediate Code area: Code Essentials Printer Friendly Version
Title: Recording Training Completion into Excel
Description: We have a Web based training that sends me an email when a person has completed it. I have these emails automatically stored in another folder as the email comes in. This code goes the that folder and parses each email (using ParseTextLinePair) and puts the data into an Excel file that I can distribute to the supervisors. After an email has been processed it is moved to an archive folder. Your web site was of great assisstance getting this done. thanks
Date: 01-Jun-2005 01:26
Code level: intermediate
Code area: Code Essentials
Posted by: Mike Woloshuk
Body: Sub RecordTrainingData() Dim myOlApp As New Outlook.Application Dim objNS As NameSpace Dim oFolderEMail As MAPIFolder Dim oFolderCE As MAPIFolder Dim oFolderSWPP As MAPIFolder Dim oFT As MAPIFolder Dim oFStore As MAPIFolder Const sEMail As String = "Email Data" Const sCE As String = "CE" Const sSWPP As String = "SWPP" Const sTraining As String = "Stormwater Training Completion" Const sExcelFile As String = "SWPP Training Completion Rooster.xls" Const sFilePath As String = "T:\Storm Water\Training Slides\" Const sWSName As String = "2005 Completion Rooster" Const iStartRow As Integer = 7 'this gets the ball rolling Set objNS = myOlApp.GetNamespace("MAPI") Set oFolderEMail = objNS.Folders("Email Data") Set oFolderCE = oFolderEMail.Folders("CE") Set oFolderSWPP = oFolderCE.Folders("SWPP") Set oFT = oFolderSWPP.Folders("Stormwater Training Completion") Set oFStore = oFT.Folders("Archive") ' oft is where all messages are that need to be processed. ' ofstore is folder where messages are moved after being processed. Dim iCount As Integer 'get total number of emails iCount = oFT.Items.Count 'open excel file and identified worksheet Dim myWB As Workbook, myWS As Worksheet Set myWB = Workbooks.Open(sFilePath & sExcelFile) Set myWS = myWB.Worksheets(sWSName) 'find first open row after title row Dim bFound As Boolean, iR As Integer, iC As Integer bFound = False iR = iStartRow Do While Not bFound If myWS.Cells(iR, 5).Value = "" Then bFound = True Else iR = iR + 1 End If Loop 'get data from each email Dim oCurrentEmail As MailItem Dim sLastN As String, sFirstN As String, sMidInt As String Dim sOff As String, sComp As String, dDateReceived As Date Dim I As Integer For I = 1 To iCount Set oCurrentEmail = oFT.Items.Item(I) sLastN = ParseTextLinePair(oCurrentEmail.Body, "SWLastName:") sFirstN = ParseTextLinePair(oCurrentEmail.Body, "SWMFirstName:") sMidInt = ParseTextLinePair(oCurrentEmail.Body, "SWMInitial:") sFirstN = sFirstN & " " & sMidInt sOff = ParseTextLinePair(oCurrentEmail.Body, "SWOfficeSymbol:") sComp = ParseTextLinePair(oCurrentEmail.Body, "SWDate:") 'get date email was received dDateReceived = oCurrentEmail.ReceivedTime 'put data into excel WS on the next available row Dim sTest As String myWS.Cells(iR, 1).Value = UCase(sLastN) myWS.Cells(iR, 2).Value = UCase(sFirstN) myWS.Cells(iR, 3).Value = UCase(sOff) myWS.Cells(iR, 4).Value = sComp myWS.Cells(iR, 5).Value = dDateReceived 'increment row iR = iR + 1 Next I 'save and close down excel objects myWB.Save myWB.Close Set myWS = Nothing Set myWB = Nothing 'move email to archive folder Dim oStoreEmail As MailItem For I = iCount To 1 Step -1 'get email Set oCurrentEmail = oFT.Items.Item(I) 'move it Set oStoreEmail = oCurrentEmail.Move(oFStore) 'execute DoEvents Next I 'close down outlook objects Set oStoreEmail = Nothing Set oCurrentEmail = Nothing Set oFStore = Nothing Set oFT = Nothing Set oFolderSWPP = Nothing Set oFolderCE = Nothing Set oFolderEMail = Nothing Set objNS = Nothing End Sub
All 14comments

	Page [ 1 2 Next >> ]
	Sue Mosher 01-Jun-2005 09:57 Nice example! Thanks for sharing it.
	Merrill Kuske 28-Oct-2005 11:32 I don't understand where ParseTextLinePair is? I looked in the VBA help system and there was not explanation. I thought this was a function and would be at the bottom of the code...not.
	Mike Woloshuk 31-Oct-2005 16:18 For Merrill. This subroutine was written by Sue Mosher and that is why i did not include it. It parses text out of the body of a message. either search on ParseTextLinePair or i think this web link will get you to the code: http://www.outlookcode.com/codedetail.aspx?id=89
	Merrill Kuske 01-Nov-2005 12:44 Thankyou-got it.
	Rafael Goncalves 12-May-2006 07:13 Very nice code... and very useful. Thank you for sharing it.
	Jigar 23-Jun-2006 16:50 This is very promising. However, being a newbie... how do I run it? I tried running it inside Outlook and get an error about Workbook not being defined (user-defined type). Thanks for your help.
	Chrys Wilkinson 26-Jun-2006 10:48 I am also getting the same error as Jigar about the workbook not being defined (user-defined type) what does this mean?? Dim myWB As Workbook, myWS as Worksheet Set myWB = Workbooks.Open(sFilePath & sExcelFile) Set myWS = myWB.Worksheets(sWSName)
	Mike Woloshuk 26-Jun-2006 14:38 for Jigar and Chrys i am assuming your excell exists? if not, it must. you also must set (check) the "mircosoft excel object library" under "tools/references" in the VB code menus sFilePath is the path ex: "c:\temp" sExcelFile is the excel file name ex: "myexcel.xls" sWSName is the worksheet name ex: "sheet1" hope this helps
	Mike Woloshuk 26-Jun-2006 14:50 i have cleaned up my code and re-submitted it. see http://www.outlookcode.com/codedetail.aspx?id=1297
	raghavendra das 27-Jul-2006 00:06 hi , i am trying to run to code but i cannot as my reference tab in tool is disabled , how to enable it.
	Page [ 1 2 Next >> ]

name email