Solved

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

Posted on 2007-11-30
18
741 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
  • 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 

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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
In this video we show how to create an email address policy in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Mail Flow…
The video tutorial explains the basics of the Exchange server Database Availability groups. The components of this video include: 1. Automatic Failover 2. Failover Clustering 3. Active Manager

777 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