Bannière

Métadonnées du document:
[ Auteur : Clockover ][ Création le : 16/10/2008 ][ Dernière modification le : 16/10/2008 ][ Version : 2.1 ]

Migration Outlook (POP3 vers Exchange) [VBS]

Introduction:

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".

Présentation du projet:

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:
flecheSituation 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.
fleche
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.
flecheSolution 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.

Mise en place:

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".

Outil de personnalisation Office 2007
Outil de personnalisation Office 2007

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

Le mot de la fin

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...

Il y a 1 commentaire(s) sur ce sujet.
L'intégralité du portail est placé sous licence Creative Commons License NC v2.0 (sauf mentions contraires indiquées sur les pages et/ou documents concernés !). Version: 4.2
Ce portail répond normalement aux critères de compatibilité XHTML v1.1 et CSS v2.0 du W3C:
Valid XHTML 1.1! Valid CSS 2.0!

Page générée en 0.008 secondes