Ghetto style mailbox sync between two exchange 2003 servers

Hello folks, some 5 years ago I figured out that it could be easy to synchronize the contents of mailboxes from one server to the other. i came up with a rather clumsy way of doing it : using ExIFS (R.I.P. exifs ! this feature is now absent from Exchange 2K7 and Exchange 2K10)

So if you're broke and cant afford Exchange 2007 / 2010 and their fancy SCR, CCR, DAG features, this is for you.

So what's the big idea : All you need is a little registry tweak in order to make exifs available thru the M: drive (like on Exchange 2000)
The robocopy tool and a little VBS script in a scheduled task.

Alas, it seems that it works only well with tiny mailboxes (less than 200 MB, 5000 mails) , but i didn't try all the robocopy switches, so maybe there is a way to avoid partial replications (missing mails).

Some drawbacks : folders must have the same names (useful to edit them on the passive server with outlook /resetfoldernames or just rename thru Exifs) And contacts are not happy with this method of syncing

And finally do not forget to put the send as / read as for your users to access their backup mbx, and also for the identity that run the script not to be blocked by "access denied"

So here is the script :



on error resume next


Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4

Dim AliasExchange
Dim IsMailSync

Set oshell = createobject("wscript.shell")
Set oFSO = createobject("scripting.filesystemobject")

Set oFile = oFSO.opentextfile("c:\scripts\mailsyncSRV1toSRV2.log",8,true)

ofile.writeline "##############début de synchronisation SRV1 vers SRV2 :" & Date() & " " & Time() & "#####################"
ofile.writeblanklines 2


set objParent = GetObject("LDAP://OU=allusers,DC=domain,DC=local")
objParent.Filter = Array("user")


for each objUser in objParent

AliasExchange = objuser.mailnickname


objuser.getinfo
err.clear
IsMailSync = objuser.get("extensionAttribute4")

if err.number <> 0 then isMailSync = ""


err.clear

if IsMailSync = "NoMailSync" then

ofile.writeline "Synchro de boite aux lettres desactivée pour : " & aliasexchange

Else

CheckFolderNames(aliasexchange)

ofile.writeline "Synchronisation de : " & aliasexchange & " debutée à : " & date() & " " & time()

oshell.run """C:\Program Files\Windows Resource Kits\Tools\robocopy.exe"" ""\\srv1\MBX$\" & AliasExchange & """ ""M:\domain.com\MBX\sec." & AliasExchange & """ /XD ""\\srv1\MBX$\" & AliasExchange & "\Contacts" & """ /E /MIR /XC /XA:H /R:0 /W:0 /NP /NFL /LOG+:c:\Scripts\sync-mbx-srv1-to-srv2.log", 0

ofile.writeline "Synchronisation de : " & aliasexchange & " finie à : " & date() & " " & time()

if err.number <> 0 then ofile.writeline err.number & " " & err.description

end if

Next

ofile.writeline "##############Fin de synchronisation SRV1->SRV2 :" & Date() & " " & Time() & "#####################"
ofile.writeblanklines 2

ofile.close


Sub CheckFolderNames(Alias)

on error resume next

set ofso = createobject("scripting.filesystemobject")
dim ofolder
dim odestfolder
dim erra
dim errb

err.clear
set ofolder = ofso.getfolder("\\srv1\MBX$\" & alias & "\Éléments envoyés")
set ofolder = ofso.getfolder("\\srv1\MBX$\" & alias & "\Éléments supprimés")
erra = err.number

err.clear
set ofolder = ofso.getfolder("\\srv1\MBX$\" & alias & "\Eléments supprimés")
set ofolder = ofso.getfolder("\\srv1\MBX$\" & alias & "\Eléments envoyés")
errb = err.number
err.clear

if (erra = 0) and (errb = 0) then exit sub

if erra = 0 then

set odestfolder = ofso.getfolder("M:\DOMAIN.COM\MBX\sec." & alias & "\Eléments envoyés")
odestfolder.name = "Éléments envoyés"
set odestfolder = ofso.getfolder("M:\DOMAIN.COM\MBX\sec." & alias & "\Eléments supprimés")
odestfolder.name = "Éléments supprimés"
err.clear

elseif errb = 0 then


set odestfolder = ofso.getfolder("M:\DOMAIN.COM\MBX\sec." & alias & "\Éléments envoyés")
odestfolder.name = "Eléments envoyés"
set odestfolder = ofso.getfolder("M:\DOMAIN.COM\MBX\sec." & alias & "\Éléments supprimés")
odestfolder.name = "Eléments supprimés"
err.clear

end if

End Sub