Solved

Monitor a public folder & move "READ Messages" to another folder at an interval

Posted on 2007-11-30
18
746 Views
Last Modified: 2010-04-21
Hi All,
We are using SBS 2003 exchange. I have a pulic folder called INPUT, I am Using Sperry Softwares AutoPrint Oultook addin to monitor this folder, And print all emails & attachments in the folder & mark each email as read once printed.

To complete a required set process I now need to set something up to scan this folder at intervals to move the "Read" messages to a subfolder called "Processed". In addition I would like to check & delete all emails from the "Processed" subfolder that are older than 60 days.

Does anyone know of an addin or macro that can do this as message rules are not able to only move Read items.
Cheerz

Bri
0
Comment
Question by:bhendrick
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 9
18 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 20384283
Hi, bhendrick.

Yes, this is possible with a fairly simple bit of scripting.  How often does the process need to run and where do you see it running from (i.e. who's computer)?  That user will have to have Outlook up and running for the script to run.
0
 

Author Comment

by:bhendrick
ID: 20385442
I would like to have it run from machine "Booking02" or user "tracy.steel" at say a 15 minute interval.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20400507
The best solution is an external script set to run via Windows Scheduled Tasks.  Follow these instructions to use this.

1.  Copy the script below and paste it into Notepad.  
2.  Save the file with a .vbs extension.  
3.  Using Windows Scheduled Tasks create a task that runs at 15 minute intervals.  Set the task to run this script.

I have not tested this script.  Use it cautiously until you have tested it.  Let me know if you run into problems and I'll correct them as quick as I can.
Dim olkApp, olkFolderInput, olkFolderProcessed, olkItems, olkItem, olkSession, intIndex
'Get the open itteration of Outlook
Set olkApp = GetObject(, "Outlook.Application")
'If Outlook was open
If TypeName(olkApp) <> "Nothing" Then
    Set olkSession = olkApp.Session
    'Get the Input folder
    'Change the folder path on the following line as needed
    Set olkFolderInput = OpenOutlookFolder("Public Folders\All Public Folders\Input")
    'Get the Processed folder
    'Change the folder path on the following line as needed
    Set olkFolderProcessed = OpenOutlookFolder("Public Folders\All Public Folders\Input\Processed")
    'Get all the read items
    Set olkItems = olkFolderInput.Items.Restrict("[Unread] = False")
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Move the read item to the Processed folder
        olkItem.Move olkFolderProcessed
    Next
    
    'Get all the items in the Processed folder
    Set olkItems = olkFolderProcessed.Items
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Was the item more than 60 days old?
        If DateDiff("d", olkItem.ReceivedTime, Date) > 60 Then
            'Delete it
            olkItem.Delete
        End If
    Next
End If
Set olkItem = Nothing
Set olkItems = Nothing
Set olkFolderInput = Nothing
Set olkFolderProcessed = Nothing
Set olkSession = Nothing
Set olkApp = Nothing
WScript.Quit
 
Function OpenOutlookFolder(strFolderPath As String)
    Dim arrFolders, varFolder, olkFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = olkSession.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window

0
MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

 

Author Comment

by:bhendrick
ID: 20401826
Thank you BlueDevilFan:

I have just tested the script as you suggested and get the following error when its is run.

Windows Script Host

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 40
Char: 42
Error: Expected ')'
Code: 800A03EE
Source: Microsoft VBScript compilation error.

Thanks
Brian.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20407425
Brian,

Change this line

    Function OpenOutlookFolder(strFolderPath As String)

to

    Function OpenOutlookFolder(strFolderPath)
0
 

Author Comment

by:bhendrick
ID: 20409853
BlueDevilFan,
 Done as stated, Now errors on next char.

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 40
Char: 43
Error: Expected Statement
Code: 800A0400
Source: Microsoft VBScript compilation error.

Regards
Bri
0
 

Author Comment

by:bhendrick
ID: 20410274
Just to confirm, I have uploaded the code as ammended.
Dim olkApp, olkFolderInput, olkFolderProcessed, olkItems, olkItem, olkSession, intIndex
'Get the open itteration of Outlook
Set olkApp = GetObject(, "Outlook.Application")
'If Outlook was open
If TypeName(olkApp) <> "Nothing" Then
    Set olkSession = olkApp.Session
    'Get the Input folder
    'Change the folder path on the following line as needed
    Set olkFolderInput = OpenOutlookFolder("Public Folders\All Public Folders\Input")
    'Get the Processed folder
    'Change the folder path on the following line as needed
    Set olkFolderProcessed = OpenOutlookFolder("Public Folders\All Public Folders\Input\Processed")
    'Get all the read items
    Set olkItems = olkFolderInput.Items.Restrict("[Unread] = False")
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Move the read item to the Processed folder
        olkItem.Move olkFolderProcessed
    Next
    
    'Get all the items in the Processed folder
    Set olkItems = olkFolderProcessed.Items
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Was the item more than 60 days old?
        If DateDiff("d", olkItem.ReceivedTime, Date) > 60 Then
            'Delete it
            olkItem.Delete
        End If
    Next
End If
Set olkItem = Nothing
Set olkItems = Nothing
Set olkFolderInput = Nothing
Set olkFolderProcessed = Nothing
Set olkSession = Nothing
Set olkApp = Nothing
WScript.Quit
 
Function OpenOutlookFolder(strFolderPath) As String)
    Dim arrFolders, varFolder, olkFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = olkSession.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
ID: 20416200
Line 40 needs to read

    Function OpenOutlookFolder(strFolderPath)

Take off the

    As String)

at the end.
0
 

Author Comment

by:bhendrick
ID: 20418103
BlueDevilFan

Sorry m8, Done as you asked, Now error on the following.

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 42
Char: 19
Error: Syntax error
Code: 800A03EA
Source: Microsoft VBScript compilation error.

Thanks.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20425055
Try this version.
Dim olkApp, olkFolderInput, olkFolderProcessed, olkItems, olkItem, olkSession, intIndex
'Get the open itteration of Outlook
Set olkApp = GetObject(, "Outlook.Application")
'If Outlook was open
If TypeName(olkApp) <> "Nothing" Then
    Set olkSession = olkApp.Session
    'Get the Input folder
    'Change the folder path on the following line as needed
    Set olkFolderInput = OpenOutlookFolder("Public Folders\All Public Folders\Input")
    'Get the Processed folder
    'Change the folder path on the following line as needed
    Set olkFolderProcessed = OpenOutlookFolder("Public Folders\All Public Folders\Input\Processed")
    'Get all the read items
    Set olkItems = olkFolderInput.Items.Restrict("[Unread] = False")
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Move the read item to the Processed folder
        olkItem.Move olkFolderProcessed
    Next
    
    'Get all the items in the Processed folder
    Set olkItems = olkFolderProcessed.Items
    For intIndex = olkItems.Count To 1 Step -1
        Set olkItem = olkItems.Item(intIndex)
        'Was the item more than 60 days old?
        If DateDiff("d", olkItem.ReceivedTime, Date) > 60 Then
            'Delete it
            olkItem.Delete
        End If
    Next
End If
Set olkItem = Nothing
Set olkItems = Nothing
Set olkFolderInput = Nothing
Set olkFolderProcessed = Nothing
Set olkSession = Nothing
Set olkApp = Nothing
WScript.Quit
 
Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, olkFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = olkSession.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
End Function
 
Function IsNothing(obj)
  Dim varTypeName
  varTypeName = TypeName(obj)
  Select Case varTypeName
  	Case "Nothing","Empty"
  		IsNothing = True
  	Case Else
  		IsNothing = False
  End Select
End Function

Open in new window

0
 

Author Comment

by:bhendrick
ID: 20571530
Hi,
         I finaly got round to looking at the new version of the script, It now errors on the following.

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 3
Char: 1
Error: ActiveX component can`t create object: 'GetObject'
Code: 800A01AD
Source: Microsoft VBScript runtime error.

Wishing you all a very Happy & Prosperous New Year
& Thanks for the help so far.

Brian.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20571763
Happy New Year, Brian.

It shouldn't be necessary, but try changing GetObject to WScript.GetObject.
0
 

Author Comment

by:bhendrick
ID: 20571786
Hi BlueDevilFan
Just tried as you asked, Result as follows

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 3
Char: 1
Error: Argument not optional: 'WScript.GetObject'
Code: 800A01C1
Source: Microsoft VBScript runtime error.

Thanks
Bri
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20571820
Oops, sorry, was getting CreateObject and GetObject confused.  Change back to just GetObject.  Try taking the space out so that line three reads

Set olkApp = GetObject(,"Outlook.Application")



0
 

Author Comment

by:bhendrick
ID: 20571844
Hi BlueDevilFan
Ok thanks, Done that, Result same as earlier.

Script: C:\Scripts\Clear_Read_Emails.vbs
Line: 3
Char: 1
Error: ActiveX component can`t create object: 'GetObject'
Code: 800A01AD
Source: Microsoft VBScript runtime error.

Thanks
Bri
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 20571870
Ok, add this line of code immediately after line #1

    On Error Resume Next
0
 

Author Closing Comment

by:bhendrick
ID: 31411896
Hi BlueDevilFan
 Thanks for all the help.

Works like a charm, Just tested it by dumping 25 emails older than 60 days into the processed subfolder, manually ran the script and its gone through and removed them correctly, I will test it a few more times then set it up as a scheduled task.

Once again Many thanks for this. You are a star.
Regards
Brian
0
 
LVL 76

Expert Comment

by:David Lee
ID: 20572204
Thanks, Brian.  I'm glad I was able to help out.  
0

Featured Post

Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
Unified and professional email signatures help maintain a consistent company brand image to the outside world. This article shows how to create an email signature in Exchange Server 2010 using a transport rule and how to overcome native limitations …
In this Micro Video tutorial you will learn the basics about Database Availability Groups and How to configure one using a live Exchange Server Environment. The video tutorial explains the basics of the Exchange server Database Availability grou…
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 …

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