Cet article présente une procédure de migration d'une messagerie en entreprise.
Il s'intéressera plus particulièrement à la partie "cliente" de la migration, c'est-à-dire aux modifications sur le logiciel Outlook.
Les documentations étant effectivement beaucoup moins disponibles sur ce point que sur la partie "serveur".

Le projet ayant vu le jour dans un cadre professionnel, il fallait y répondre de la façon la plus élégante et automatique possible. En effet, les manipulations auraient pu être faites très simplement en les faisant manuellement mais cela aurait été une perte de temps considérable sans parler de l'intérêt technique qui aurait été nul.

Il fallait donc répondre à la problématique suivante:
Situation actuelle:
Chaque utilisateur dispose d'un client de messagerie de type Outlook en version 2003/2007. Sa messagerie fonctionne à l'aide d'un compte POP3 ce qui alimente un PST local qui ne peut être sauvegardé facilement. Du fait que cette solution est implémentée depuis un certain temps, aucuns quotas n'existent et les PSTs sont de taille très variable. Il est également possible que l'utilisateur dispose de plusieurs comptes POP3.

Situation vers laquelle tendre:
Chaque utilisateur disposera du même client de messagerie. Cependant, il fonctionnera dorénavant à l'aide d'une connexion MAPI sur un serveur Exchange (très nombreux avantages en termes de sauvegarde et travail collaboratif). Les PSTs préexistants devront toujours être consultables. Et il doit être possible de retourner à l'état précédent rapidement.
Solution retenue:
Nous allons nous servir des stratégies de groupe pour appliquer les modifications aux différents clients à l'aide d'un script VBS et d'une customisation Outlook. Du fait, de la taille variable des PSTs nous choisiront de ne pas les réimporter dans le serveur Exchange mais de les ouvrir dans Outlook comme des archives. Enfin, les profils Outlook actuels ne seront pas supprimés afin d'y revenir rapidement en cas de problème.

La customisation Outlook

Afin de créer un fichier de customisation pour Outlook (.prf), il faut utiliser l'installateur d'Office 2007 La commande à exécuter est : "lecteur:\setup.exe /admin".

Nous nous servirons de cet outil uniquement pour indiquer les paramètres du nouveau profil utilisant le serveur Exchange.
Pour cela, il faut sélectionner : "Nouveau profil" dont le nom sera "exchange".
Ensuite, il faudra spécifier les bons paramètres sur la page prévu à cette effet (serveur exchange, nom d'utilisateur...).
Et enfin, nous exporterons la personnalisation dans un fichier .prf.

Le script VBS de migration

Nous allons maintenant nous occuper du "moteur" de la migration. Le script qui va gérer automatiquement les différents cas de figure et faire les modifications appropriées. Ce script sera simplement à insérer dans une stratégie de groupe.

'Migration Outlook
'Version 0.3 20081016 by Clockover
 
'-----------------------------------------------------------------------------------------
'MAIN
'-----------------------------------------------------------------------------------------
On Error Resume Next
Const HKEY_CURRENT_USER = &H80000001
Const r_PSTGuidLocation = "01023d00"
Const r_MasterConfig = "01023d0e"
Const r_PSTCheckFile = "00033009"
Const r_PSTFile = "001f6700"
Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const r_DefaultOutlookProfile = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const r_DefaultProfileString = "DefaultProfile"
Dim oReg        	:Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Dim objFSO    		:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objPSTLog    	:Set objPSTLog = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\pst.log",2,True)
Dim objProfilLog    :Set objProfilLog = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\profil.log",2,True)  
Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName
Dim pathPRF			:Set pathPRF = c:\fichier.prf
oReg.GetStringValue HKEY_CURRENT_USER,r_DefaultOutlookProfile,r_DefaultProfileString,DefaultProfileName

'Detecter si Outlook a déjà été lancé et possède des profils
Set WS = CreateObject("WScript.Shell")
val = WS.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\")
'La clé registre n'existe pas: Outlook n'a jamais été lancé.
If (Err.number = -2147024893) or (Err.number = -2147024894) Then	
	ImportPRF()
'La clé registre existe: Outlook a déjà été lancé.
Else
	StrProfil = WS.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile")
	'Le profil "exchange" n'est pas par défaut: Modification.
	if StrProfil <> "exchange" then	
		'Récuperer les PSTs actuellement actifs
		GetPSTsForProfile(StrProfil)
		'Noter le profil par défaut dans un fichier de log en cas de problème.
		objProfilLog.WriteLine(StrProfil)
		'Importer le profil Exchange
		ImportPRF()
		'Remonter les PSTs en archive
		mountPST()
	end if
End If

'-----------------------------------------------------------------------------------------
'FONCTIONS
'-----------------------------------------------------------------------------------------
Function ImportPRF()
Dim verOffice(2)
verOffice(0) = "Office"		'Outlook XP et plus vieux
verOffice(1) = "Office11"	'Outlook 2003
verOffice(2) = "Office12"	'Outlook 2007

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")

'Boucle de recherche de la version utilisée
For each i in verOffice	
File_exec = "C:\Program Files\Microsoft Office\" & i & "\OUTLOOK.EXE"
if fso.FileExists(File_exec) Then
	Set watt_exc = WshShell.Exec(File_exec & " /importprf " & pathPRF)
end if
Next
WshShell.Exec(File_exec)
End Function
'-----------------------------------------------------------------------------------------
Function GetPSTsForProfile(p_profileName)
Dim strHexNumber, strPSTGuid, strFoundPST
Dim HexCount    :HexCount = 0

oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
   For i = lBound(strValue) to uBound(strValue)    
           If Len(Hex(strValue(i))) = 1 Then 
               strHexNumber = "0" & Hex(strValue(i))
           Else
               strHexNumber = Hex(strValue(i))
           End If        
       strPSTGuid = strPSTGuid + strHexNumber
       HexCount = HexCount + 1
           If HexCount = 16 Then 
                   If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
                       objPSTLog.WriteLine(PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid)))
                   End If    
               HexCount = 0
               strPSTGuid = ""
           End If            
   Next
   'GetPSTsForProfile = strFoundPST
End Function
'-----------------------------------------------------------------------------------------
Function IsAPST(p_PSTGuid)
Dim x, P_PSTGuildValue
Dim P_PSTCheck:P_PSTCheck=0
IsAPST=False
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
   For x = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)    
       P_PSTCheck = P_PSTCheck + Hex(P_PSTGuildValue(x))
   Next    
   If P_PSTCheck=20 Then
       IsAPST=True
   End If    
End Function 
'-----------------------------------------------------------------------------------------
Function PSTlocation(p_PSTGuid)
Dim y, P_PSTGuildValue, t_strHexNumber
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
   For y = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)    
       If Len(Hex(P_PSTGuildValue(y))) = 1 Then
           PSTlocation = PSTlocation + "0" & Hex(P_PSTGuildValue(y))
       Else
           PSTlocation = PSTlocation + Hex(P_PSTGuildValue(y))    
       End If    
   Next    
End Function 
'-----------------------------------------------------------------------------------------
Function PSTFileName(p_PSTGuid)
Dim z, P_PSTName
Dim strString:strString = ""
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName
   For z = lBound(P_PSTName) to uBound(P_PSTName)    
       If P_PSTName(z) > 0 Then
           strString = strString & Chr(P_PSTName(z))
       End If    
   Next    
   PSTFileName = strString
Set z = nothing
Set P_PSTName = nothing
End Function 
'-----------------------------------------------------------------------------------------
Function ExpandEvnVariable(ExpandThis)
Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function
'-----------------------------------------------------------------------------------------
Function mountPST()
Dim objFSO    :Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim ObjTextStream : Set ObjTextStream = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\pst.log",1,False)    

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNameSpace("MAPI")

Dim strtmp  
Do While Not ObjTextStream.AtEndOfStream
strtmp = Split(ObjTextStream.ReadAll, vbCrLf)
For i = 0 To UBound(strtmp) 
	if strtmp(i) <> "" then
		myNameSpace.AddStore(strtmp(i))
	End if
Next
Loop
ObjTextStream.Close
Set ObjTextStream = Nothing
End Function

Le script VBS de retour en arrière

En cas de problème, un script VBS a été prévu pour revenir en arrière soit de façon localisé, soit généralisé.

'Anti-Migration Outlook
'Version 0.1 20081016 by Clockover

Dim objFSO    		:Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objProfilLog    :Set objProfilLog = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\profil.log",1,False) 

'Detecter si Outlook a déjà été lancé et possède des profils
Set WS = CreateObject("WScript.Shell")
val = WS.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\")
'La clé registre n'existe pas: Outlook n'a jamais été lancé.
If (Err.number = -2147024893) or (Err.number = -2147024894) Then
	ImportPRF()
'La clé registre existe: Outlook a déjà été lancé.
Else
	StrProfil = WS.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile")
	'Le profil "exchange" n'est pas par défaut: On ne touche rien
	if StrProfil <> "exchange" then
	'Le profil "exchange" est celui par défaut: On le change
	else	
		strtmp = Split(objProfilLog.ReadAll, vbCrLf)
		WS.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile", strtmp(0)
	end if
End If

'-----------------------------------------------------------------------------------------
Function ExpandEvnVariable(ExpandThis)
Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function

La solution mise en place permet aussi de configurer automatiquement le profil Outlook des personnes qui viennent d'arriver. Cependant, ce n'est pas du tout sa fonction première et si il s'agit du but à atteindre, il existe d'autres solutions plus appropriées.
La fonction de récupération des chemins des fichiers PSTs n'est pas de moi et manque malheureusement de commentaire. Mais l'idée de l'article est de donner des pistes de recherches et de travaux et non pas de donner un cours de VBS.
En espérant, que cela puisse inspirer certains...