Office 2007 upgrade & autoarchive problems
Office 2007 upgrade & autoarchive problems
Synopsis of problem:
Autoarchive quits working on users' mailboxes "all of a sudden". Investigation reveals that all messages have a single modified timestamp that does NOT coincide with an actual time of response or forwarding. Autoarchiving starts functioning as advertised *PAST* the modification timestamp. Manual archive does not work either, because it is based on the same settings.
Synopsis on how autoarchive works:
Autoarchive looks at the modify timestamp (found under "message properties") of each message. If the modify date is prior to the autoarchive date, the message is moved out from the active mailbox to the user's set archive pst file.
Presumably, the rationale of having modify vs. created/received date is that it updates the modified-stamp if you reply to or forward an old message, thereby keeping it "active".
Potential (conjectured) cause:
We suspect that when Office gets upgraded from one version to the other, it upgrades the .ost file from one format to the next. Updating the ost file probably resets the modify date on every message. Once you go online, it probably updates the main message store with the "new" modify timestamp, and therefore breaks autoarchive. Pst files work a bit differently than ost- pst updates do NOT change modify time, but ost updates do.
Another newly discovered interaction has to do with McAfee AV potentially scanning and touching modify time of certain messages.
Potential solution*:
When upgrading Outlook users' laptops- try to disable offline folders first. This requires a restart of Outlook. Then upgrade Outlook, then enable offline folders again... see if this avoids the problem to begin with. Again, those steps are:
1. Open Outlook, old version.
2. Disable offline folders and/or cached exchange mode if enabled.
3. Close outlook, wait 15 sec, reopen Outlook, wait 15 sec, close Outlook.
4. Upgrade.
5. Open Outlook, enable offline folders and/or cached exchange mode, have the user wait for the ost to populate.
*: This solution has not even been tried, let alone tested, but it seems to me that this is one of the only ways to work around the limitations.
Of course, given that we cannot predict who this will happen to, it is a lot of work to go through, with not very much to show for it after the fact.
Update:
As of June 13th, 2008, we are working on a script that will allow autoarchive based on receive date instead of modify date. More information as we proceed.
As of July 9th, 2008, we have a script that will allow autoarchiving of 1500 items or less based on receive date. More testing to follow.
As of November 3rd, our script is still unable to break the 1500 item barrier, active work on this script has been shelved until a later date.
As of November 18th, 2008, a breakthrough! We will post a copy of the script here shortly.
This script is intended to be run on NON-ECN MACHINES ONLY! This script is provided AS-IS as-is, with no implied warranty... Do not redistribute without the copyright notice at the header. If this script does what you need it to do, please drop us a thank-you email saying so!!
If you are using an ECN supported machine, please contact your site specialist instead of using this script.
Contents of script file ArchiveOutlookByReceivedDate.vbs
'
' This script scans through the Outlook mailbox,
' and moves items to the archive based on Received date.
'
'-------------------------------------------------------------------
'
' Copyright 2008, Purdue University, West Lafayette, Indiana, USA
'
' Author: Rex Bontrager
' Creation date: 2008 June 03
'
'-------------------------------------------------------------------
option explicit
RunWithCScript
Const olFolderCalendar = 9
Const olFolderContacts = 10
Const olFolderDeletedItems = 3
Const olFolderDrafts = 16
Const olFolderInbox = 6
Const olFolderJournal = 11
Const olFolderNotes = 12
Const olFolderOutbox = 4
Const olFolderSentMail = 5
Const olFolderTasks = 13
Const olPublicFoldersAllPublicFolders = 18
const iPrimaryExchangeMailbox = 0
Dim OutlookApp : Set OutlookApp = CreateObject("Outlook.Application")
CheckVersion
Dim myNameSpace : Set myNameSpace = OutlookApp.GetNamespace("MAPI")
Dim Mailboxes : Set Mailboxes = myNameSpace.Folders 'same as Stores
dim Stores : Set Stores = OutlookApp.Session.Stores 'same as Mailboxes
dim Store, oFrStore, oToStore, sFr, sTo, CutoffDate, gMoveCnt, BeforeCnt, rc1, rc2
dim olExchangeStoreType
olExchangeStoreType = array("PrimaryExchangeMailbox", _
"ExchangeMailbox", _
"ExchangePublicFolder", _
"NotExchange")
'--set defaults
sFr = ""
sTo = ""
CutoffDate = SetCutoffDate("6 months")
set oFrStore = nothing
set oToStore = nothing
'--parse args
if wscript.Arguments.Count>0 then sFr = wscript.Arguments(0)
if wscript.Arguments.Count>1 then sTo = wscript.Arguments(1)
if wscript.Arguments.Count>2 then CutoffDate = SetCutoffDate(wscript.Arguments(2))
if wscript.Arguments.Count>3 then Bomb "Too many arguments"
on error resume next
if sFr<>"" then set oFrStore=Stores(sFr)
rc1 = err.number
err.clear
if sTo<>"" then set oToStore=Stores(sTo)
rc2 = err.number
if rc1<>0 or rc2<>0 then
if rc1<>0 then say "Arg1 is not a valid mailbox: " & sFr
if rc2<>0 then say "Arg2 is not a valid archive store: " & sTo
say "Valid mailboxes/stores are:"
for each Store in Stores
say " " & Store.DisplayName
next
Bomb ""
end if
if not isDate(CutoffDate) then Bomb "Arg3 is not 'n days' or 'n months'"
on error goto 0
'--select defaults
if oFrStore is nothing or oToStore is nothing then
for each Store in Stores
with Store
'say ""
'say .DisplayName
'say "Application = " & .Application
'say "Class = " & .Class
'say "DisplayName = " & .DisplayName
'say "ExchangeStoreType = " & olExchangeStoreType(.ExchangeStoreType)
'say "FilePath = " & .FilePath
'say "IsCachedExchange = " & .IsCachedExchange
'say "IsDataFileStore = " & .IsDataFileStore
'say "IsInstantSearchEnabled = " & .IsInstantSearchEnabled
'say "IsOpen = " & .IsOpen
'say "Parent = " & .Parent
'say "PropertyAccessor = " & .PropertyAccessor
'say "Session = " & .Session
'say "StoreID = " & .StoreID
if (oFrStore is nothing) and .ExchangeStoreType=iPrimaryExchangeMailbox then
set oFrStore = Store
end if
if (oToStore is nothing) and .IsDataFileStore and inStr(Lcase(.DisplayName & .FilePath), "archive")>0 then
set oToStore = Store
end if
end with
next
end if
'--manually select
if oFrStore is nothing then
set oFrStore = SelectMailbox("Your ACTIVE MAILBOX could not be determined. Please select one:")
if oFrStore is nothing then
Bomb "Cannot determine your active mailbox -- terminating"
end if
end if
if oToStore is nothing then
set oToStore = SelectMailbox("Your ARCHIVE STORE could not be determined. Please select one:")
if oToStore is nothing then
Bomb "Cannot determine your archive store -- terminating"
end if
end if
'--confirm & process
if MsgBox("Ready to archive email that was received on or before " & FrmtDate(CutoffDate) & "." & vbLF & _
"Moving email from """ & oFrStore.DisplayName & """ to """ & oToStore.DisplayName & """" & vbLF & vbLF & _
"Continue?", vbYesNo, "Archive email?")=vbYes then
gMoveCnt = 0
do
BeforeCnt = gMoveCnt
DoTopFolder oFrStore.GetRootFolder, oToStore.GetRootFolder
say ">>> Total moved: " & gMoveCnt
loop until gMoveCnt=BeforeCnt
end if
'OutlookApp.Quit
set OutlookApp = nothing
'end main
sub DoTopFolder (oFrFolder, oToFolder)
if gMoveCnt=0 then
say ""
say "--------------------------------------------"
say " " & oFrFolder.Name
say "--------------------------------------------"
' say "addrbook=" & TopFolder.AddressBookName
' say "app =" & TopFolder.Application
' say "class =" & TopFolder.Class
' say "descrip =" & TopFolder.Description
' say "entryid =" & TopFolder.EntryID
' say "fldrpath=" & TopFolder.FolderPath
' say "inappfld=" & TopFolder.InAppFolderSyncObject
' say "name =" & TopFolder.Name
' say "parent =" & TopFolder.Parent
' say "session =" & TopFolder.Session
' say "storeid =" & TopFolder.StoreID
' say "unread =" & TopFolder.UnreadItemCount
end if
DoFolder oFrFolder.Folders("Inbox"), oToFolder, 1
end sub
sub DoFolder (oFrFolder, oToFolder, Level)
'
' oFrFolder is the "From" folder that is to be checked.
' oFrFolder changes with recursive invocations.
' oToFolder is the high-level destination folder that is
' to receive files and folders from oFrFolder.
' oToFolder is the same for all invocations.
' Level is the subpath depth in oFrFolder being
' processed.
'
dim subfolder, item, arItems, cnt, k
for each subfolder in oFrFolder.Folders
DoFolder subfolder, oToFolder, Level+1
next
'
' Since items are moved from the collection,
' we must collect all the candidate items
' before actually moving them. Otherwise,
' the collection loop gets messed up.
'
redim arItems(oFrFolder.Items.Count) 'index 1 = 1st item
cnt = 0
for each item in oFrFolder.Items
if isCandidate(item) then
cnt = cnt+1
set arItems(cnt) = item
end if
next
if cnt>0 then
say ">>> Folder """ & oFrFolder.Name & """ has " & oFrFolder.Items.Count & " items, moving " & cnt & " items"
end if
for k=1 to cnt
set item = arItems(k)
MoveItem oFrFolder, oToFolder, Level, item
next
end sub
function isCandidate (Item)
dim DT, Subj, rc, rs
on error resume next
''' .CreationTime
''' .ExpiryTime
''' .LastModificationTime
DT = Item.ReceivedTime
''' .ReminderTime
rc = err.number
rs = err.description
Subj = Item.Subject
on error goto 0
if rc<>0 or not isDate(DT) then
' say "Failed to get item's date, rc=" & rc & "=" & rs
' say " " & Subj
isCandidate = false
else
isCandidate = DT<CutoffDate
end if
end function
sub MoveItem (oFrFolder, oToFolder, Level, Item)
dim arFr, oTo, sLevelName, k
'--insure destination folder exists
set oTo = oToFolder
arFr = split(oFrFolder.FolderPath, "\")
for k=1 to Level
sLevelName = arFr(ubound(arFr)-Level+k)
on error resume next
oTo.Folders.Add sLevelName, olFolderInbox 'might already exist
on error goto 0
set oTo = oTo.Folders(sLevelName)
next
'--move item
gMoveCnt = gMoveCnt+1
say gMoveCnt & ": " & FrmtDate(Item.ReceivedTime) & " " & Item.Subject
on error resume next
Item.Move oTo
if err.number<>0 then
say " Move failed, rc=" & err.number & ": " & err.description
end if
on error goto 0
end sub
function SetCutoffDate (sInterval)
'
' sInterval can be "n days" or "n months". The space is optional.
' If valid, returns a DateValue. If invalid, returns null.
'
dim k, quan, unit
quan = 0
unit = ""
for k=1 to len(sInterval)
if not isNumeric(mid(sInterval,k,1)) then exit for
next
quan = left(sInterval,k-1)
unit = Lcase(left(trim(mid(sInterval,k)),1)) 'must be "d" or "m"
if isNumeric(quan) and (unit="d" or unit="m") then
SetCutoffDate = DateValue(DateAdd(unit, -CInt(quan), Now))
else
SetCutoffDate = null
end if
end function
function FrmtDate (Dval)
FrmtDate = right("0" & month(Dval),2) & "/" & right("0" & day(Dval),2) & "/" & year(Dval)
end function
function SelectMailbox (text)
dim indx, Store
set SelectMailbox = nothing
say text
indx = 0
for each Store in Stores
indx = indx+1
say indx & ": " & Store.DisplayName
next
wscript.StdOut.Write "Enter 1-" & Stores.Count & ": "
indx = wscript.StdIn.ReadLine
if isNumeric(indx) then
if CInt(indx)>=1 and CInt(indx)<=Stores.Count then
set SelectMailbox = Stores(CInt(indx))
end if
end if
end function
sub CheckVersion
dim ar
ar = split(OutlookApp.Version, ".")
if CInt(ar(0)) < 12 then
BombLine "This script requires Outlook 2007 or later"
wscript.quit 1
end if
end sub
sub RunWithCScript
'
' Insure that CScript (not WScript) is running
'
dim shell : set shell = CreateObject("wscript.shell")
dim sEngine : sEngine = mid(wscript.FullName,1+InStrRev(wscript.FullName, "\"))
dim sNewCmdLine, arg
if ucase(sEngine)="WSCRIPT.EXE" then
sNewCmdLine = """" & wscript.Path & "\CScript.exe"" //NoLogo """ & wscript.ScriptFullName & """"
for each arg in wscript.Arguments
sNewCmdLine = sNewCmdLine & " """ & arg & """"
next
shell.Run sNewCmdLine
wscript.Quit
end if
end sub
sub Bomb (text)
BombLine text
BombLine ""
BombLine "Syntax: " & wscript.ScriptName & " [mailboxName [archiveName [archiveAge]]]"
BombLine ""
BombLine " where"
BombLine " mailboxName = name of Outlook mailbox"
BombLine " archiveName = name of Outlook archive store"
BombLine " archiveAge = how old an item must be to be archived"
BombLine " (""n days"" or ""n months"")"
BombLine " (default = 6 months)"
OutlookApp.Quit
set OutlookApp = nothing
wscript.quit 1
end sub
sub BombLine (text)
wscript.StdErr.WriteLine wscript.ScriptName & ": " & text
end sub
sub say (text)
wscript.StdOut.WriteLine text
'wscript.StdErr.WriteLine text
end sub
Last modified: 2014/06/18 15:28:24.677070 GMT-4 by
christopher.n.deckard.1
Created: 2008/06/10 11:35:25.918000 GMT-4 by sundeep.rao.1.
Categories
- Knowledge Base > Software > Email > Outlook