Solved

Compare follow-up completed date with received date

Posted on 2006-06-09
19
259 Views
Last Modified: 2008-09-09
Experts,

I am running Exchange Server 2003 SP1 and Outlook 2003. I have a number of group mailboxes each one assigned to a specific client. My team of CSR's open the emails, take action on them, and then mark the email as completed by double-clicking on the flag icon. At the end of the month, the project leader goes into the mailbox and manually opens each email and compares the completed date on the email to the received date of the email to verify that the response was completed within a 24 hour period. This is extremely tedious and is not at all productive as there are about 2000 emails per month per account. Is there some way to automate this process? As usual, thanks for your help in advance.

Mikel948
0
Comment
Question by:mikel948
  • 10
  • 9
19 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 16877771
Greetings, mikel948.

Here's a script for doing this.  I wrote and tested this using Outlook 2003.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Modules and click on Module1
4.  Copy the code below and paste it into the right-hand pane of the VB editor window.
5.  Edit the code as needed.  There are comments where things should be changed.
6.  Click Tools->References
7.  Scroll through the list of references until you find "Microsoft CDO 1.21 Library"
8.  Check the box next to it.
9.  Click OK.
10. Click the diskette icon on the toolbar to save changes
11. Close the VB Editor
12. Click Tools->Macro->Security
13. Set the Security Level to Medium
14. Run the macro.  It will produce a text file listing the messages that are more than 24 hours old along with their actual age in hours.

'Include a project reference to Microsoft CDO 1.21 Library
Option Explicit

Dim objCDO As New MAPI.Session, _
    objRootFolder As MAPI.Folder, _
    objFolder As MAPI.Folder, _
    objInfoStore As MAPI.InfoStore, _
    objFSO As Object, _
    objFile As Object
   
Sub ShowCompletionInterval()
    'Replace MyProfileName and MyProfilePassword with your profile name and password
    objCDO.Logon "MyProfileName"
    'Replace MyStore with the name of a mailbox or personal folder and MyFolder with the name
    'of a folder within that store that you want as your starting point.  All folders below this point
    'will be processed.
    If GetStartingFolder("MyStore", "MyFolder") Then
        'Create a text file to hold the output
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Replace the file name and path on the next line with those you want to use.
        Set objFile = objFSO.CreateTextFile("C:\eeTesting\Message Completion Run (" & Replace(Date, "/", "-") & ").txt")
        objFile.WriteLine "Age" & vbTab & "Message Subject"
        objFile.WriteLine ""
        'Call the folder check begining with the root folder
        ProcessFolder objRootFolder
    End If
    'Log out from CDO
    objCDO.Logoff
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objRootFolder = Nothing
    Set objInfoStore = Nothing
    Set objCDO = Nothing
    'Close the text file and destroy those objects too
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "All done!"
End Sub

Function GetStartingFolder(strStoreName As String, strFolderName As String) As Boolean
    Dim bolFound As Boolean
    GetStartingFolder = False
    For Each objInfoStore In objCDO.InfoStores
        If objInfoStore.Name = strStoreName Then
            For Each objRootFolder In objInfoStore.RootFolder.Folders
                If objRootFolder.Name = strFolderName Then
                    bolFound = True
                    GetStartingFolder = True
                    Exit For
                End If
            Next
            If bolFound Then
                Exit For
            End If
        End If
    Next
End Function

Sub ProcessFolder(objFolder As MAPI.Folder)
    Dim objSubFolders As MAPI.Folders, _
        objSubFolder As MAPI.Folder, _
        objMessages As MAPI.Messages, _
        objMessage As MAPI.Message, _
        objFields As MAPI.Fields, _
        objField As MAPI.Field, _
        intAgeInHours As Integer
    'Does this folder contain any messages
    If objFolder.Messages.Count > 0 Then
        'Get the messages collection
        Set objMessages = objFolder.Messages
        'Process the messages
        For Each objMessage In objMessages
            Set objFields = objMessage.Fields
            On Error Resume Next
            Set objField = objFields.Item(&H10910040)
            If Err.Number = 0 Then
                'Calculate the difference between arrival and being marked complete
                intAgeInHours = DateDiff("h", objMessage.TimeReceived, objField.Value)
                'Was it more then 24 hours
                If intAgeInHours > 24 Then
                    objFile.WriteLine PadLeft(Val(intAgeInHours), 4) & vbTab & objMessage.Subject
                End If
                'Give the OS a chance to do something
                DoEvents
            End If
            On Error GoTo 0
            Set objField = Nothing
        Next
    End If
    'Does this folder have subfodlers
    If objFolder.Folders.Count > 0 Then
        'Grab the subfolders
        Set objSubFolders = objFolder.Folders
        'Loop through those subfolders
        For Each objSubFolder In objSubFolders
            'Recursively call this subroutine
            ProcessFolder objSubFolder
        Next
    End If
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objSubFolders = Nothing
    Set objMessage = Nothing
    Set objMessages = Nothing
End Sub

Function PadLeft(strValue As String, intLength As Integer)
    Dim intActualLength As Integer
    intActualLength = Len(Trim(strValue))
    If intActualLength < intLength Then
        PadLeft = String(intLength - intActualLength, " ") & Trim(strValue)
    Else
        PadLeft = strValue
    End If
End Function


Cheers!
0
 

Author Comment

by:mikel948
ID: 16888200
Hey BlueDevilFan,

Thanks for the script. As soon as I get it working, you'll get the 500 points.  I am getting a run-time error 91, Object variable or With block variable not set. It breaks at objFile.Close.

Best regards,

mikel948
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16890827
That's indicative that the main portion of the code (i.e. the portion within the IF ... END IF in the subroutine ShowCompletionInterval) never ran.  That would mean that the store and/or root folder name weren't found.  We can avoid the error message in this situation by moving the line of code cauing the error inside the IF ... END IF.  Move this line of code

    objFile.Close

immediately after

    ProcessFolder objRootFolder
0
 

Author Comment

by:mikel948
ID: 16921912
Hey BlueDevilFan,

I have been out of town so I haven't been able to test this until now. I no longer receive the error message and the script seems to run; however, no output file is created.

Mikel948
0
 

Author Comment

by:mikel948
ID: 16983965
Hello. Anyone, a little help getting this to work?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 16987433
Mikel948,

Sorry, somehow I missed your 6/16 message.  Have you adjusted the file name and path per the comments in the code?
0
 

Author Comment

by:mikel948
ID: 17002135
Hey BlueDevilFan,

In the Sub ShowCompletionInterval() routine I entered:
 
objCDO.Logon "Outlook", "mydomainpassword"

If GetStartingFolder("mailbox", "inbox") I have also tried "mailbox-mikel948", "mikel948", "Outlook" as the mystore entry

Set objFile = objFSO.CreateTextFile("C:\report (" & Replace(Date, "/", "-") & ").txt")

What am I doing wrong?

Mikel948

0
 
LVL 76

Expert Comment

by:David Lee
ID: 17004824
> objCDO.Logon "Outlook", "mydomainpassword"
You don't need your password.  Since you're already singed into Outlook when this runs it's not necessary.  There can only be one profile logged in, all additional sessions use that profile and it's already been authenticated.  THis just satellites off of it.

> If GetStartingFolder("mailbox", "inbox")
"mailbox" should be the name of the default mail delivery location.  If you're on Exchange, then that'd be something like "Mailbox - Doe, John".  If you're using POP instead, then it'd be the name, inside Outlook, not the file name, of the PST file containing your inbox.  Inbox will normally be just that, Inbox.

0
 
LVL 76

Expert Comment

by:David Lee
ID: 17065931
Hi, mikel948.

Any progress?
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:mikel948
ID: 17108337
Hey BlueDevilFan,

I am sorry I haven't got back to you sooner; I am getting slammed all over the board. I still cannot get the report to generate. AT first I though it was because I was trying to access a mailbox that I have access to through Outlook, but I also tried it on my own mailbox and It still does't work. Here is a copy of the code I am trying to use to access a project mailbox:

'Include a project reference to Microsoft CDO 1.21 Library
Option Explicit

Dim objCDO As New MAPI.Session, _
    objRootFolder As MAPI.Folder, _
    objFolder As MAPI.Folder, _
    objInfoStore As MAPI.InfoStore, _
    objFSO As Object, _
    objFile As Object
   
Sub ShowCompletionInterval()
    'Replace MyProfileName and MyProfilePassword with your profile name and password
    objCDO.Logon "outlook"
    'Replace MyStore with the name of a mailbox or personal folder and MyFolder with the name
    'of a folder within that store that you want as your starting point.  All folders below this point
    'will be processed.
    If GetStartingFolder("Mailbox-xxxxxxxxxxx", "RESOLVED EMAIL") Then
        'Create a text file to hold the output
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Replace the file name and path on the next line with those you want to use.
        Set objFile = objFSO.CreateTextFile("C:\testing\report (" & Replace(Date, "/", "-") & ").txt")
        objFile.WriteLine "Age" & vbTab & "Message Subject"
        objFile.WriteLine ""
        'Call the folder check begining with the root folder
        ProcessFolder objRootFolder
        objFile.Close
    End If
    'Log out from CDO
    objCDO.Logoff
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objRootFolder = Nothing
    Set objInfoStore = Nothing
    Set objCDO = Nothing
    'Close the text file and destroy those objects too
    'objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "All done!"
End Sub

Function GetStartingFolder(strStoreName As String, strFolderName As String) As Boolean
    Dim bolFound As Boolean
    GetStartingFolder = False
    For Each objInfoStore In objCDO.InfoStores
        If objInfoStore.Name = strStoreName Then
            For Each objRootFolder In objInfoStore.RootFolder.Folders
                If objRootFolder.Name = strFolderName Then
                    bolFound = True
                    GetStartingFolder = True
                    Exit For
                End If
            Next
            If bolFound Then
                Exit For
            End If
        End If
    Next
End Function

Sub ProcessFolder(objFolder As MAPI.Folder)
    Dim objSubFolders As MAPI.Folders, _
        objSubFolder As MAPI.Folder, _
        objMessages As MAPI.Messages, _
        objMessage As MAPI.Message, _
        objFields As MAPI.Fields, _
        objField As MAPI.Field, _
        intAgeInHours As Integer
    'Does this folder contain any messages
    If objFolder.Messages.Count > 0 Then
        'Get the messages collection
        Set objMessages = objFolder.Messages
        'Process the messages
        For Each objMessage In objMessages
            Set objFields = objMessage.Fields
            On Error Resume Next
            Set objField = objFields.Item(&H10910040)
            If Err.Number = 0 Then
                'Calculate the difference between arrival and being marked complete
                intAgeInHours = DateDiff("h", objMessage.TimeReceived, objField.Value)
                'Was it more then 24 hours
                If intAgeInHours > 24 Then
                    objFile.WriteLine PadLeft(Val(intAgeInHours), 4) & vbTab & objMessage.Subject
                End If
                'Give the OS a chance to do something
                DoEvents
            End If
            On Error GoTo 0
            Set objField = Nothing
        Next
    End If
    'Does this folder have subfodlers
    If objFolder.Folders.Count > 0 Then
        'Grab the subfolders
        Set objSubFolders = objFolder.Folders
        'Loop through those subfolders
        For Each objSubFolder In objSubFolders
            'Recursively call this subroutine
            ProcessFolder objSubFolder
        Next
    End If
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objSubFolders = Nothing
    Set objMessage = Nothing
    Set objMessages = Nothing
End Sub

Function PadLeft(strValue As String, intLength As Integer)
    Dim intActualLength As Integer
    intActualLength = Len(Trim(strValue))
    If intActualLength < intLength Then
        PadLeft = String(intLength - intActualLength, " ") & Trim(strValue)
    Else
        PadLeft = strValue
    End If
End Function


Thanks,
Mikel948
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17109122
Mikel948,

> I am getting slammed all over the board
No problem.  I understand.

Replace the ShowCompletionInterval subroutine with the one below.  I added a couple of commands to display information about what's going on and help us figure this out.  Try running it again and let me know what message you receive.

Sub ShowCompletionInterval()
    'Replace MyProfileName and MyProfilePassword with your profile name and password
    objCDO.Logon "outlook"
    'Replace MyStore with the name of a mailbox or personal folder and MyFolder with the name
    'of a folder within that store that you want as your starting point.  All folders below this point
    'will be processed.
    If GetStartingFolder("Mailbox-xxxxxxxxxxx", "RESOLVED EMAIL") Then
        MsgBox "The mailbox was found."
        'Create a text file to hold the output
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Replace the file name and path on the next line with those you want to use.
        Set objFile = objFSO.CreateTextFile("C:\testing\report (" & Replace(Date, "/", "-") & ").txt")
        objFile.WriteLine "Age" & vbTab & "Message Subject"
        objFile.WriteLine ""
        'Call the folder check begining with the root folder
        ProcessFolder objRootFolder
        objFile.Close
    Else
        MsgBox "The mailbox was not found."
    End If
    'Log out from CDO
    objCDO.Logoff
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objRootFolder = Nothing
    Set objInfoStore = Nothing
    Set objCDO = Nothing
    'Close the text file and destroy those objects too
    'objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "All done!"
End Sub
0
 

Author Comment

by:mikel948
ID: 17111093
OK. No matter which mailbox I try to access, including my own, I first get the mailbox not found msg box, then the all done msg box.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17128889
Sorry to be slow.  What we have is a path problem.  I put this routine together so you can list the names of the stores in you profile.  Copy and paste this code in with what you already have.  When you run it a dialog-box will pop up showing the names of your information stores as Outlook sees them.

Sub ListMAPIStores()
    Dim objCDO As Object, _
        objStore As Object, _
        strStores As String
    Set objCDO = CreateObject("MAPI.Session")
    'Change the profile name as needed
    objCDO.Logon "Outlook"
    For Each objStore In objCDO.InfoStores
        strStores = strStores & objStore.Name & vbCrLf
    Next
    MsgBox strStores, vbInformation + vbOKOnly, "Your Information Stores"
    Set objCDO = Nothing
    Set objStore = Nothing
End Sub
0
 

Author Comment

by:mikel948
ID: 17130047
Finally! I got my report to print.

I have an email that I received on July 1 at 11:21 AM and it was completed on July 6 4:40 PM. The age column shows 125 What is the Age column showing?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17134958
Great news.

> The age column shows 125 What is the Age column showing?
It's showing the age of the item in hours.
0
 

Author Comment

by:mikel948
ID: 17140494
Hey BlueDevilFan,

You rock. Before I close this out and give you the points, I want to know if you can tweak the report a little more. (you know how end-users are, give them an inch and they scream for a mile). If you could make these changes for me, I'll give you another 250 points.

Ideally, they would like to have the report show received date, completion date, total time difference in days not hours and subject line. The reason they want all this is if an email comes in on Saturday it won't be looked at for a minimum of 48 hours and they don't want to penalize the CSR who responds to the email. Let me know if this is possible.

Best regards,

Mikel948
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 17142172
Ok, I made the changes.  Replace the ProcessFolder sub that you have with the one below.  It'll show the extra fields you wanted and I changed the caluculation to use days instead of hours.  I appreciate the offer of 250 additonal points, but the maximum value for a question is 500 points.  You can't up the value beyond the 500 you've already set, and giving me the points in any other fashion would be a violation of EE's rules.  I'd have to decline them.  Please save them for another question.

Sub ProcessFolder(objFolder As MAPI.Folder)
    Dim objSubFolders As MAPI.Folders, _
        objSubFolder As MAPI.Folder, _
        objMessages As MAPI.Messages, _
        objMessage As MAPI.Message, _
        objFields As MAPI.Fields, _
        objField As MAPI.Field, _
        intAgeInDays As Integer
    'Does this folder contain any messages
    If objFolder.Messages.Count > 0 Then
        'Get the messages collection
        Set objMessages = objFolder.Messages
        'Process the messages
        For Each objMessage In objMessages
            Set objFields = objMessage.Fields
            On Error Resume Next
            Set objField = objFields.Item(&H10910040)
            If Err.Number = 0 Then
                'Calculate the difference between arrival and being marked complete
                intAgeInDays = DateDiff("d", objMessage.TimeReceived, objField.Value)
                'Was it more then 1 day
                If intAgeInDays > 1 Then
                    objFile.WriteLine objMessage.TimeReceived & vbTab & objField.Value & vbTab & PadLeft(Val(intAgeInDays), 4) & vbTab & objMessage.Subject
                End If
                'Give the OS a chance to do something
                DoEvents
            End If
            On Error GoTo 0
            Set objField = Nothing
        Next
    End If
    'Does this folder have subfodlers
    If objFolder.Folders.Count > 0 Then
        'Grab the subfolders
        Set objSubFolders = objFolder.Folders
        'Loop through those subfolders
        For Each objSubFolder In objSubFolders
            'Recursively call this subroutine
            ProcessFolder objSubFolder
        Next
    End If
    'Destroy the CDO objects to avoid memory leaks
    Set objFolder = Nothing
    Set objSubFolders = Nothing
    Set objMessage = Nothing
    Set objMessages = Nothing
End Sub
0
 

Author Comment

by:mikel948
ID: 17147908
Hey BlueDevilFan,

Again I want to let you know that you rock! I really appreciate the way that you worked through this with me. I am sure I will have more questions for you in the future.

Best regards,

Mikel948
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17147926
Thanks, Mikel948!  I appreciate that.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
Find out how to use dynamic social media in email signatures with this top 10 DOs & DON’Ts.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now