voila le bout de code que nous utilisons.
bon alors il est certainement améliorable hein, mais chez nous il fait le job ^^
je ne suis pas à l'origine de tout le code, je me suis inspiré de scripts existants et j'ai fait ma ptite adaptation ^^
le script:
- fait une recherche dans l'AD
- génère les 2 signatures
- indique dans le registre quelle signature utiliser quand
'Option Explicit
On Error Resume Next
' 1. déclaration des variables
'-----------------------------
' Objets requête LDAP, réseau et utilisateur
Dim qQuery, objSysInfo, objuser
' Objet Outlook
Dim Outlook
' Informations sur l'utilisateur
Dim FullName, EMail, Title, PhoneNumber, MobileNumber, FaxNumber, OfficeLocation, Department
Dim web_address, StreetAddress, Town, State, Company
Dim ZipCode, PostOfficeBox
' Locatisations de répertoire
Dim FolderLocation, UserDataPath
' Chaîne réutilisable
Dim SignatureEnvoi, SignatureReponse, Localisation, LocalisationReponse
' Version d'outlook
dim outlookver
' Divers
dim CheckTime
' Initialisation de variables - les changements doivent être faits ici sur cette variable
'--------------------------------------
Localisation = "Signatures"
SignatureEnvoi = "Signature-envoi"
SignatureReponse = "Signature-reponse"
'--------------------------------------
' En premier, obtenir la version d'outlook
'--------------------------------------------------
set outlook = createobject("outlook.application" )
outlookver = Left(outlook.version, InStr(outlook.version, "." )-1)
set Outlook = nothing
' Petite boucle basée sur le temps pour attendre la fermeture d'outlook
'----------------------------------------------------------------------------
CheckTime = timer
while (timer - checktime) < 10
' on ne fait rien, on attend juste que Outlook se termine...
Wend
' On récupère les informations utilisateurs de l'AD par l'intermédiaire d'une requête LDAP
'---------------------------------------------------------------------------------------------------
Set objSysInfo = CreateObject("ADSystemInfo" )
objSysInfo.RefreshSchemaCache
qQuery = "LDAP://" & objSysInfo.Username
Set objuser = GetObject(qQuery)
FullName = objuser.displayname
EMail = objuser.mail
Company = objuser.Company
Title = objuser.title
PhoneNumber = objuser.TelephoneNumber
FaxNumber = objuser.FaxNumber
OfficeLocation = objuser.physicalDeliveryOfficeName
StreetAddress = objuser.streetaddress
PostofficeBox = objuser.postofficebox
Department = objUser.Department
ZipCode = objuser.postalcode
Town = objuser.l
MobileNumber = objuser.TelephoneMobile
web_address = objUser.wWWHomePage
' CREATION DE LA SIGNATURE D'ENVOI
'---------------------------------------------------------------------
Dim SignEnvoi, RegistreEnvoi
Set SignEnvoi = CreateObject("WScript.Shell" )
' Modification du chemin contenant la signature dans la base de registre basée sur la version d'outlook
RegistreEnvoi = "HKEY_CURRENT_USER\Software\Microsoft\Office\"&OutlookVer&".0\Common\General\Signatures"
SignEnvoi.RegWrite RegistreEnvoi , Localisation
' Création du chemin local contenant les signatures
'--------------------------------------------------
UserDataPath = SignEnvoi.ExpandEnvironmentStrings("%appdata%" )
FolderLocation = UserDataPath &"\Microsoft\"&Localisation&"\"
' On précise ici la signature Nouveau message
'-----------------------------------------------------------
SignEnvoi.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\"&outlookVer&".0\Common\MailSettings\NewSignature" , SignatureEnvoi
SignEnvoi.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\"&OutlookVer&".0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
' on vérifie si le chemin local des signatures existe. sinon on le crée.
'-----------------------------------------------------------------------
Dim DossierEnvoi
Set DossierEnvoi = CreateObject("Scripting.FileSystemObject" )
If (DossierEnvoi.FolderExists(FolderLocation)) Then
Else
Call DossierEnvoi.CreateFolder(FolderLocation)
End if
' On crée le fichier de signature
'-------------------------------------------
Dim SIGNATURE1
Dim FicEnvoi,afile1, SignFoll1, Folcoll1, SubFoll1
Dim aQuote
aQuote = chr(34)
' Adaptation du modèle
'-------------------------------------------
Set SIGNATURE1 = CreateObject("Scripting.FileSystemObject" )
' on efface toutes les signatures présente dans le chemin local des signatures
'------------------------------------------------------------------------------------
SIGNATURE1.DeleteFile(Folderlocation & "*.*" )
' suppresion de tout répertoire dans ce dossier
'------------------------------------------------------
set SignFoll1 = SIGNATURE1.GetFolder(FolderLocation)
Set Folcoll1 = SignFoll1.SubFolders
For Each subfol in Folcoll1
subFol.Delete true
Next
Set FicEnvoi = SIGNATURE1.CreateTextFile(FolderLocation&"\"&SignatureEnvoi&".htm",True)
FicEnvoi.Close
Set FicEnvoi = SIGNATURE1.OpenTextFile(FolderLocation&"\"&SignatureEnvoi&".htm", 2)
' Signature en code HTML. Vous pouvez modifier à loisir ce code pour l'adapter selon vos besoins.
'--------------------------------------
dest_sign = "<!DOCTYPE HTML PUBLIC " & aQuote & "-//W3C//DTD HTML 4.0 Transitional//EN" & aQuote & ">" & vbCrLf
dest_sign = dest_sign & "<html>"
dest_sign = dest_sign & "<head>"
dest_sign = dest_sign & "<style>"
dest_sign = dest_sign & "body {"
dest_sign = dest_sign & "color : #365D91;"
dest_sign = dest_sign & "font-family : Calibri;"
dest_sign = dest_sign & "font-size : 11.0pt;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & "</style>"
dest_sign = dest_sign & "</head>"
dest_sign = dest_sign & "<body>"
dest_sign = dest_sign & "<a href="&aQuote&"SOMEWHERE"&aQuote&"><img border=0 width=595 height=144 src="&aQuote&"EMPLACEMENT IMAGE HAUT"&aQuote&"></a>"
dest_sign = dest_sign & "<style>"
dest_sign = dest_sign & "<!--"
dest_sign = dest_sign & ".texte {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".username {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".title {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " font-style: Italic;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".site {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".telephone {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".mobile {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & "-->"
dest_sign = dest_sign & "</style>"
dest_sign = dest_sign & "<BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR><BR>"
dest_sign = dest_sign & "<div class="&aQuote&"username"&aQuote&">"&Fullname&"</div>"
dest_sign = dest_sign & "<div class="&aQuote&"title"&aQuote&">"&Title&"</div>"
dest_sign = dest_sign & "<div class="&aQuote&"site"&aQuote&">"&OfficeLocation&"</div>"
dest_sign = dest_sign & "<div class="&aQuote&"telephone"&aQuote&">"&PhoneNumber&"</div>"
dest_sign = dest_sign & "<div class="&aQuote&"mobile"&aQuote&">"&MobileNumber&"</div>"
dest_sign = dest_sign & "<div class="&aQuote&"web"&aQuote&"><a href="&aQuote&"http://"&web_address&aQuote&">"&web_address&"</a></div>"
dest_sign = dest_sign & "<div class="&aQuote&"texte"&aQuote&">------------------------</div>"
dest_sign = dest_sign & "<a href="&aQuote&"SOMEWHERE"&aQuote&"><img border=0 width=595 height=144 src="&aQuote&"EMPLACEMENT IMAGE BAS"&aQuote&"></a>"
dest_sign = dest_sign & "</body>"
dest_sign = dest_sign & "</html>"
' Fin de la personnalisation
'--------------------------------------
FicEnvoi.write dest_sign
FicEnvoi.Close
' On crée ici les signatures
' A partir d'ici, toute la méthode n'est pas supportée par Microsoft.
'---------------------------------------------------------------------
Dim SignReponse, RegistreReponse
Set SignReponse = CreateObject("WScript.Shell" )
' Modification du chemin contenant la signature dans la base de registre basée sur la version d'outlook
RegistreReponse = "HKEY_CURRENT_USER\Software\Microsoft\Office\"&OutlookVer&".0\Common\General\Signatures"
SignReponse.RegWrite RegistreReponse , Localisation
' Création du chemin local contenant les signatures
'--------------------------------------------------
UserDataPath = SignReponse.ExpandEnvironmentStrings("%appdata%" )
FolderLocation = UserDataPath &"\Microsoft\"&Localisation&"\"
' On précise ici la signature reponse
'-----------------------------------------------------------
'SignEnvoi.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\"&outlookVer&".0\Common\MailSettings\NewSignature" , SignatureEnvoi
SignReponse.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\"&OutlookVer&".0\Common\MailSettings\ReplySignature" , SignatureReponse
SignReponse.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\"&OutlookVer&".0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
' on vérifie si le chemin local des signatures existe. sinon on le crée.
'-----------------------------------------------------------------------
Dim DossierReponse
Set DossierReponse = CreateObject("Scripting.FileSystemObject" )
If (DossierReponse.FolderExists(FolderLocation)) Then
Else
Call DossierReponse.CreateFolder(FolderLocation)
End if
' On crée le fichier de signature
'-------------------------------------------
Dim SIGNATURE2
Dim FicReponse,afile2, SignFoll2, Folcoll2, SubFoll2
Dim aQuote2
aQuote2 = chr(34)
' Adaptation du modèle
'-------------------------------------------
Set SIGNATURE2 = CreateObject("Scripting.FileSystemObject" )
' on efface toutes les signatures présente dans le chemin local des signatures
'------------------------------------------------------------------------------------
'SIGNATURE2.DeleteFile(Folderlocation & "*.*" )
' suppresion de tout répertoire dans ce dossier
'------------------------------------------------------
set SignFoll2 = SIGNATURE2.GetFolder(FolderLocation)
Set Folcoll2 = SignFoll2.SubFolders
For Each subfol in Folcoll2
subFol.Delete true
Next
Set FicReponse = SIGNATURE2.CreateTextFile(FolderLocation&"\"&SignatureReponse&".htm",True)
FicReponse.Close
Set FicReponse = SIGNATURE2.OpenTextFile(FolderLocation&"\"&SignatureReponse&".htm", 2)
' Signature en code HTML. Vous pouvez modifier à loisir ce code pour l'adapter selon vos besoins.
'--------------------------------------
dest_sign = "<!DOCTYPE HTML PUBLIC " & aQuote2 & "-//W3C//DTD HTML 4.0 Transitional//EN" & aQuote2 & ">" & vbCrLf
dest_sign = dest_sign & "<html>"
dest_sign = dest_sign & "<head>"
dest_sign = dest_sign & "<style>"
dest_sign = dest_sign & "body {"
dest_sign = dest_sign & "color : #365D91;"
dest_sign = dest_sign & "font-family : Calibri;"
dest_sign = dest_sign & "font-size : 11.0pt;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & "</style>"
dest_sign = dest_sign & "</head>"
dest_sign = dest_sign & "<body>"
dest_sign = dest_sign & "<style>"
dest_sign = dest_sign & "<!--"
dest_sign = dest_sign & ".texte {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".username {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".title {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " font-style: Italic;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".site {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".telephone {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & ".mobile {"
dest_sign = dest_sign & " font-family: Calibri;"
dest_sign = dest_sign & " font-size: 11.0pt;"
dest_sign = dest_sign & " color: #000000;"
dest_sign = dest_sign & "}"
dest_sign = dest_sign & "-->"
dest_sign = dest_sign & "</style>"
dest_sign = dest_sign & "<div class="&aQuote2&"username"&aQuote2&">"&Fullname&"</div>"
dest_sign = dest_sign & "<div class="&aQuote2&"title"&aQuote2&">"&Title&"</div>"
dest_sign = dest_sign & "<div class="&aQuote2&"site"&aQuote2&">"&OfficeLocation&"</div>"
dest_sign = dest_sign & "<div class="&aQuote2&"telephone"&aQuote2&">"&PhoneNumber&"</div>"
dest_sign = dest_sign & "<div class="&aQuote2&"mobile"&aQuote2&">"&MobileNumber&"</div>"
dest_sign = dest_sign & "<div class="&aQuote2&"texte"&aQuote2&">------------------------</div>"
dest_sign = dest_sign & "</body>"
dest_sign = dest_sign & "</html>"
' Fin de la personnalisation
'--------------------------------------
FicReponse.write dest_sign
FicReponse.Close
'---------------------------------------------------------------------
' Cette section prend le profil courant d'Outlook et y place le nom de la signature par défaut
'---------------------------------------------------------------------
' Use this version to set all accounts in the default mail profile to use a previously created signature
Call SetDefaultSignature(SignatureEnvoi,"" )
Call SetReplySignature(SignatureReponse,"" )
Sub SetDefaultSignature(strSignName, strProfile)
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
If Not IsOutlookRunning Then
Set objreg = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv" )
strKeyPath = "Software\Microsoft\Windows NT\" & "CurrentVersion\Windows " & "Messaging Subsystem\Profiles\"
' get default profile name if none specified
If strProfile = "" Then
objreg.GetStringValue HKEY_CURRENT_USER, strKeyPath, "DefaultProfile", strProfile
End If
' build array from signature name
myArray = StringToByteArray(strSignName, True)
strKeyPath = strKeyPath & strProfile & "\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys
For Each subkey In arrProfileKeys
strsubkeypath = strKeyPath & "\" & subkey
objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "New Signature", myArray
Next
Else
strMsg = "Please shut down Outlook before " & "running this script."
MsgBox strMsg, vbExclamation, "SetDefaultSignature"
End If
End Sub
Sub SetReplySignature(strSignName, strProfile)
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
If Not IsOutlookRunning Then
Set objreg = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv" )
strKeyPath = "Software\Microsoft\Windows NT\" & "CurrentVersion\Windows " & "Messaging Subsystem\Profiles\"
' get default profile name if none specified
If strProfile = "" Then
objreg.GetStringValue HKEY_CURRENT_USER, strKeyPath, "DefaultProfile", strProfile
End If
' build array from signature name
myArray = StringToByteArray(strSignName, True)
strKeyPath = strKeyPath & strProfile & "\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys
For Each subkey In arrProfileKeys
strsubkeypath = strKeyPath & "\" & subkey
objreg.SetBinaryValue HKEY_CURRENT_USER, strsubkeypath, "Reply-Forward Signature", myArray
Next
Else
strMsg = "Please shut down Outlook before " & "running this script."
MsgBox strMsg, vbExclamation, "SetReplySignature"
End If
End Sub
Function IsOutlookRunning()
strComputer = "."
strQuery = "Select * from Win32_Process " & "Where Name = 'Outlook.exe'"
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2" )
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If UCase(objProcess.Name) = "OUTLOOK.EXE" Then
IsOutlookRunning = True
Else
IsOutlookRunning = False
End If
Next
End Function
Public Function StringToByteArray (Data, NeedNullTerminator)
Dim strAll
strAll = StringToHex4(Data)
If NeedNullTerminator Then
strAll = strAll & "0000"
End If
intLen = Len(strAll) \ 2
ReDim arr(intLen - 1)
For i = 1 To Len(strAll) \ 2
arr(i - 1) = CByte ("&H" & Mid(strAll, (2 * i) - 1, 2))
Next
StringToByteArray = arr
End Function
Public Function StringToHex4(Data)
' Input: normal text
' Output: four-character string for each character,
' e.g. "3204" for lower-case Russian B,
' "6500" for ASCII e
' Output: correct characters
' needs to reverse order of bytes from 0432
Dim strAll
For i = 1 To Len(Data)
' get the four-character hex for each character
strChar = Mid(Data, i, 1)
strTemp = Right("00" & Hex(AscW(strChar)), 4)
strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
Next
StringToHex4 = strAll
End Function