More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 21-Feb-2019 21:19

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
This message is displayed as VB.NET
 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 >>  
  01-Jun-2005  09:57   
Nice example! Thanks for sharing it.
  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.
  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
 
  01-Nov-2005  12:44   
Thankyou-got it.
  12-May-2006  07:13   
Very nice code... and very useful.
Thank you for sharing it.
  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.
  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)
  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
 
  26-Jun-2006  14:50   
i have cleaned up my code and re-submitted it.

see http://www.outlookcode.com/codedetail.aspx?id=1297


 
  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 >>