Question : how to move email items from one folder to another on a schedule based on a date criteria in outlook.

Outlook rules (if automatically triggered) only deal with a single email at a time.  Also, the rule is typically only triggered when an email is received or sent.

What I would like is to 1) trigger an action (move message) on a schedule (each night), 2) based on a date received criteria.

Auto Archive will not cut it.

Answer : how to move email items from one folder to another on a schedule based on a date criteria in outlook.

This should do it.  I say "should" because I don't have 2010 loaded and can't test against it.  I did test using 2007 and it worked fine.  Follow these instructions to use the code.

1.  Open Notepad
2.  Copy the code and paste it into Notepad
3.  Save the file with a .vbs extension
4.  Create a scheduled task
5.  Set the task to run this script
6.  The script takes three parameters: srcFolderPath tgtFolderpath Days
     where
          srcFolderPath is the path to the Outlook folder to move items from (enclose the path in quotes if it contains a space)
          tgtFolderPath is the path to the Outlook folder tp move items to (enclose the path in quotes if it contains a space)
          Days is the age of messages you want to move (i.e. only those that are as old or older than x days)
     example
          "mailbox - doe, john\inbox" backups\2010 7    This would move all items that are 7 or more days old from John Doe's inbox to a folder named 2010 in the pst file named Backups

     Outlook folder paths are no different from file system folder paths with one exception: they don't use a drive letter.  The path to any Outlook folder is the name of each folder from the root to the target folder.

7.  Test the script by running the task immediately.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
Dim strSrcFolder, strTgtFolder, varDays, olkApp, olkSes, olkSrc, olkTgt, olkLst, olkItm, intCnt
If WScript.Arguments.Count < 3 Then
	WScript.Echo "You must pass three arguments to the script."
Else
	Set olkApp = CreateObject("Outlook.Application")
	Set olkSes = olkApp.GetNamespace("MAPI")
	olkSes.Logon olkApp.DefaultProfileName
	strSrcFolder = WScript.Arguments.Item(0)
	strTgtFolder = WScript.Arguments.Item(1)
	varDays = WScript.Arguments.Item(2)
	If OutlookFolderExists(strSrcFolder) Then
		If OutlookFolderExists(strTgtFolder) Then
			If IsNumeric(varDays) Then
				Set olkSrc = OpenOutlookFolder(strSrcFolder)
				Set olkTgt = OpenOutlookFolder(strTgtFolder)
				Set olkLst = olkSrc.items.restrict("[ReceivedTime] <= '" & OutlookSearchDateFormat(DateAdd("d", varDays * -1, Now)) & "'")
				For intCnt = olkLst.Count To 1 Step -1
					Set olkItm = olkLst.item(intCnt)
					olkItm.Move olkTgt
				Next
			Else
				MsgBox "The number of days you sepcified is not a number.",vbCritical+vbOKOnly,"Script Processing Terminated"
			End If
		Else
			MsgBox "The target folder you specified does not exists.",vbCritical+vbOKOnly,"Script Processing Terminated"
		End If
	Else
		MsgBox "The source folder you specified does not exists.",vbCritical+vbOKOnly,"Script Processing Terminated"
	End If
End If
Set olkItm = Nothing
Set olkLst = Nothing
Set olkTgt = Nothing
Set olkSrc = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
WScript.Quit

Function OutlookSearchDateFormat(varDate)
	OutlookSearchDateFormat = FormatDateTime(varDate, vbShortDate) & " " & Hour(vardate) & ":" & Minute(vardate) & " " & AMPM(varDate)
End Function

Function AMPM(varDate)
	If Hour(varDate) >= 12 Then
	    AMPM = "PM"
	Else
	    AMPM = "AM"
	End If
End Function

Function OutlookFolderExists(strFolderPath)
    ' Purpose: Tests to see if an Outlook folder exists based on a path string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    OutlookFolderExists = (TypeName(OpenOutlookFolder(strFolderPath)) <> "Nothing")
End Function

Function OpenOutlookFolder(strFolderPath)
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders, varFolder, bolBeyondRoot
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = olkSes.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function
Random Solutions  
 
programming4us programming4us