More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 21-Sep-2017 10:27

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: This is an update to my 1 June 05 submittal. I have cleaned up my code. 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 to 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 assistance getting this done. Thanks
Date: 26-Jun-2006  14:48
Code level: intermediate
Code area: Code Essentials
Posted by: Mike Woloshuk
This message is displayed as VB.NET
 Sub SWPP_SPCC_Training()
    Dim myOlApp As New Outlook.Application
    Dim objNS As NameSpace
    Dim oFolderEMail As MAPIFolder
    Dim oFolder As MAPIFolder
    Dim oFolderSub1 As MAPIFolder
    Dim oFolderSub2 As MAPIFolder
    Dim oFStore As MAPIFolder
    Const sEMail As String = "Email Data"
    Const sFolder As String = "CE"
    Const sSubFolder1 As String = "SWPP"
    Const sFolderSub2 As String = "Training Completion"
    Const sArchive As String = "Archive"
    Const sExcelFile As String = "SWPPP & SPCC Training Completion Rooster.xls"
    Const sFilePath As String = "N:\Storm Water\Training Slides\"
    Const sWSName As String = "2006 Completion Rooster"
    Const iStartRow As Integer = 7
    Const sEmailSubj As String = "Stormwater & Oil Spill Prevention Training Completion"
    Const sEmailLastName As String = "SWLastName:"
    Const sEmailFirstName As String = "SWFirstName:"
    Const sEmailMInitial As String = "SWMInitial:"
    Const sEmailOfficeSymbol As String = "SWOfficeSymbol:"
    Const sEmailDate As String = "Date:"
    
    'this gets the ball rolling
    Set objNS = myOlApp.GetNamespace("MAPI")
    Set oFolderEMail = objNS.Folders(sEMail)
    Set oFolder = oFolderEMail.Folders(sFolder)
    Set oFolderSub1 = oFolder.Folders(sSubFolder1)
    Set oFolderSub2 = oFolderSub1.Folders(sFolderSub2)
    Set oFStore = oFolderSub2.Folders(sArchive)
    ' oFolderSub2 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 = oFolderSub2.Items.Count
    
    'check to see if file exist
    Dim sDoesExcelExist As String
    sDoesExcelExist = Dir(sFilePath & sExcelFile, vbNormal)
    If sDoesExcelExist <> "" Then
        '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 = oFolderSub2.Items.Item(I)
          'get only the training records
          If oCurrentEmail.Subject = sEmailSubj Then
            sLastN = ParseTextLinePair(oCurrentEmail.Body, sEmailLastName)
            sFirstN = ParseTextLinePair(oCurrentEmail.Body, sEmailFirstName)
            sMidInt = ParseTextLinePair(oCurrentEmail.Body, sEmailMInitial)
            sFirstN = sFirstN & " " & sMidInt
            sOff = ParseTextLinePair(oCurrentEmail.Body, sEmailOfficeSymbol)
            sComp = ParseTextLinePair(oCurrentEmail.Body, sEmailDate)
            'get date email was received
            dDateReceived = oCurrentEmail.ReceivedTime
            'set email to read
            oCurrentEmail.UnRead = False
            'put data into excel WS on the next available row
            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
          End If
        Next I
        
        'sort by last name - in column 1
        Dim iEndRow As Integer
        'define last row
        iEndRow = iR - 1
        With myWS
          ' .row defines row to be sorted
          ' sort defines the sort with the key being the last name
          .Rows(iStartRow & ":" & iEndRow). _
            Sort Key1:=.Cells(iStartRow - 1, 1), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
          ' reset selection to starting row
          .Cells(iStartRow, 1).Select
        End With
        
        'save and close down excel objects
        myWB.Save
        myWB.Close
        Set myWS = Nothing
        Set myWB = Nothing
        
        'move emails to archive folder
        Dim oStoreEmail As MailItem
        For I = iCount To 1 Step -1
          'get email
          Set oCurrentEmail = oFolderSub2.Items.Item(I)
          'move only training records
          If oCurrentEmail.Subject = sEmailSubj Then
            'move it
            Set oStoreEmail = oCurrentEmail.Move(oFStore)
            'execute
            DoEvents
          End If
        Next I
    Else
        MsgBox "Excel file could not be found: " & sFilePath & sExcelFile
    End If
    
    'close down outlook objects
    Set oStoreEmail = Nothing
    Set oCurrentEmail = Nothing
    Set oFStore = Nothing
    Set oFolderSub2 = Nothing
    Set oFolderSub1 = Nothing
    Set oFolder = Nothing
    Set oFolderEMail = Nothing
    Set objNS = Nothing
End Sub
All 56comments
Page [ 1 2 3 4 5 6 Next >>  
  12-Jul-2006  11:05   
Thanks for posting the code. I was able to use it to derive my own program to sort through undeliverarble emails. The program goes through a folder, which contains undeliverable notices and retreives the email addresses in the body which it stores in an Excel file. Once it is finishes with the email, it moves the email to another folder. If no email address are found, however, it leaves it in the folder for further review. We can then compare this file to file containing account numbers and contact information to find out which accounts need updating.
 
  03-Aug-2006  11:36   
 Const sEMail As String = "Email Data"
This line does it refer to a folder on the hard drive or does it refer to a folder in Outlook?
I tried changing it to a folder in Outlook and I still received and error.
Thanks
  27-Aug-2006  09:19   
Ray
if you are referring to "email data", this is the name of the Outlook personnel pst file and "CE" would be a folder in the "email data" file. hope this helps.
  17-Nov-2006  17:34   
Mike, can you make this a bit clearer? I am having difficulty understanding the folder structure of the folders.
 
  20-Nov-2006  19:18   
sEMail is the PST file name and is also the root directory of the email folder. In this example, my pst file is "email data.pst".

email data
    - sFolder - a folder of email data (ex: inbox, delete, sent)
        - sSubFolder1 - a subfolder of sFolder
            - sSubFolder2 - a subfolder of sSubFolder1
                - sArchive - a subfolder of sSubFolder2

My office stuff goes into folders under CE
SWPP is my storm water info and my training is stored under "Training Completion"

I hope this helps.
  30-Nov-2006  14:54   
Excuse my ignorance this is my first time dealing with Outlook in VB.
Can you explain what this line refers to?
Const iStartRow As Integer = 7
Why 7?
(Great code btw!)
  30-Nov-2006  16:53   
 Not a problem. "iStartRow " is the first available row in Excel where the information (First name, Last name, etc.) from a message will be placed. In my application, I used rows 1-6 for the the Title and column identifiers as shown below.

Storm Water Pollution & Oil Spill Prevention

                                                                                     Date
            Office Date Email
Last Name First Name Symbol Completed Received
 
When the program begins putting message data in the Excel file, it first finds the available row starting at row 7 that is empty. Non-empty cells has data from another message.
glad to help
  30-Nov-2006  16:57   


Storm Water Pollution & Oil Spill Prevention
columns did not line up right.

                                                                                  Date
                                            Office Date Email
Last Name First Name Symbol Completed Received
 
  30-Nov-2006  17:00   
"date" should be over "completed" and "email" should be over "received"
  01-Dec-2006  00:32   
I have use this code also and it works great. I always get asked by outlook however to allow access to the script (which you can grant for 1min, 2min 5min or 10min) am I able to give unrestricted access to a specific project?
 
Page [ 1 2 3 4 5 6 Next >>