Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 756
  • Last Modified:

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

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
bhendrick
Asked:
bhendrick
  • 9
  • 9
1 Solution
 
David LeeCommented:
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
 
bhendrickAuthor Commented:
I would like to have it run from machine "Booking02" or user "tracy.steel" at say a 15 minute interval.
0
 
David LeeCommented:
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
bhendrickAuthor Commented:
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
 
David LeeCommented:
Brian,

Change this line

    Function OpenOutlookFolder(strFolderPath As String)

to

    Function OpenOutlookFolder(strFolderPath)
0
 
bhendrickAuthor Commented:
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
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
Line 40 needs to read

    Function OpenOutlookFolder(strFolderPath)

Take off the

    As String)

at the end.
0
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
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
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
Happy New Year, Brian.

It shouldn't be necessary, but try changing GetObject to WScript.GetObject.
0
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
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
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
Ok, add this line of code immediately after line #1

    On Error Resume Next
0
 
bhendrickAuthor Commented:
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
 
David LeeCommented:
Thanks, Brian.  I'm glad I was able to help out.  
0

Featured Post

Creating Active Directory Users from a Text File

If your organization has a need to mass-create AD user accounts, watch this video to see how its done without the need for scripting or other unnecessary complexities.

  • 9
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now