Compare follow-up completed date with received date

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!

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

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

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

Hello. Anyone, a little help getting this to work?

Mikel948,

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

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

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

Hi, mikel948.

Any progress?

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

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

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.

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

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?

Great news.

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

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

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

Thanks, Mikel948!  I appreciate that.