Microsoft Exchange : Signatures pour Outlook avec VBS, Active Directory et GPO

Rédigé par Joseph MICACCIA - -
itskills.micaccia.eu:Signature automatique pour Microsoft Outlook

J'ai eu besoin d'un script pour la gestion des signatures dans Outlook. En navigant sur Internet, je me suis apperçu rapidement que je n'étais pas seul à le chercher.

En finalité, j'ai recueilli quelques bouts de codes ici et là. Puis, de ce qui m'a semblé être le meilleur, j'ai fait une synthèse.
 

itskills.micaccia.eu:outlook signatures

 

J'aurai voulu citer le nom des auteurs des codes trouvés ici et là. A défaut de pouvoir les citer, dans la partie "Références et bibliographie", sont mentionnés quelques uns des sites où j'ai puisé mon inspiration.

Je diffuse le résultat final sur internet, en espérant qu'il sera utile à celles et ceux qui recherchent un produit de ce type. Vous êtes libre de faire ce que vous voulez de ce script. Accessoirement, vous pouvez citer la source, itskills.micaccia.eu, si vous voulez.

 

"FirmaDitta"

("SignatureEntreprise" en Italien)


 

S'agissant du script pour la signature Outlook, elle devait correspondre aux critères suivants :

  • être créée automatiquement dans Outlook, en utilisant Active Directory et les GPO
  • respecter la charte graphique de l'entreprise (police, couleurs, etc.)
  • contenir un lien web (site de l'entreprise) et une image (logo de l'entreprise)
  • être non modifiable par l'utilisateur, accessoirement

 

Voici le script "FirmaDitta.vbs" :

 
  1. ' **********************************************************************
  2. ' Title : FirmaDitta.vbs
  3. ' Description : This VB script automatically creates custom signatures
  4. ' for Microsoft Outlook, from Active Directory, using COM objects
  5. ' Author : Joseph MICACCIA
  6. ' Date : 2016.08.24
  7. ' Version : 1.0
  8. ' **********************************************************************
  9.  
  10. On Error Resume Next
  11.  
  12. ' # Get user's data from Active Directory
  13. Set objSysInfo = CreateObject("ADSystemInfo")
  14. sUtente = objSysInfo.UserName
  15. Set objUser = GetObject("LDAP://" & sUtente)
  16. uFirstName = objUser.givenName
  17. uName = objUser.sn
  18. uTitle = objUser.Title
  19. uTelephone = "Tel. : " & objUser.TelephoneNumber
  20. if Len(objUser.Mobile)>0 then
  21. uMobile = " - Mob. : " & objUser.Mobile
  22. else
  23. uMobile = ""
  24. end if
  25. uStreet = objUser.StreetAddress
  26. uPostal = objUser.PostalCode
  27. uCity = objUser.l
  28.  
  29. ' # Create the Word document using COM objects
  30. vBack2Line = chr(11)
  31. vColorBlue = RGB(0,32,96) '6299648
  32. vColorGray = RGB(128,128,128) '8418944
  33. vCompanyName = "Micaccia"
  34. vCompanyUrl = "www.micaccia.com"
  35. vCompanyLink = "http://www.micaccia.com"
  36. vLogoImage = "\\micaccia.priv\netlogon\micaccia.FirmaDitta.jpg"
  37. Set objWord = CreateObject("Word.Application")
  38. Set objDoc = objWord.Documents.Add()
  39. Set objSelection = objWord.Selection
  40. Set objEmailOptions = objWord.EmailOptions
  41. Set objSignatureObject = objEmailOptions.EmailSignature
  42. Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
  43. objSelection.Font.Name = "Arial"
  44. objSelection.Font.Size = 10
  45. objSelection.TypeParagraph()
  46. objSelection.Font.Color = vColorBlue
  47. objSelection.TypeText "Cordialement,"
  48. objSelection.TypeText vBack2Line
  49. objSelection.TypeText uFirstName & " "
  50. objSelection.Font.Bold = True
  51. objSelection.TypeText uName
  52. objSelection.Font.Bold = False
  53. objSelection.TypeText vBack2Line
  54. objSelection.TypeText uTitle
  55. objSelection.TypeText vBack2Line
  56. objSelection.Font.Color = vColorGray
  57. objSelection.TypeText uTelephone & uMobile
  58. objSelection.Font.Color = vColorBlue
  59. objSelection.TypeText vBack2Line
  60. objSelection.TypeText uStreet & " - " & uPostal & " " & uCity
  61. objSelection.TypeText vBack2Line
  62. objSelection.TypeText vBack2Line
  63. Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, vCompanyLink,,, vCompanyUrl)
  64. objLink.Range.Font.Color = vColorBlue
  65. objLink.Range.Font.Name = "Arial"
  66. objLink.Range.Font.Size = 10
  67. ObjLink.Range.Font.Bold = true
  68. objSelection.TypeText vBack2Line
  69. objSelection.InlineShapes.AddPicture(vLogoImage)
  70. Set objSelection = objDoc.Range()
  71.  
  72. ' # Set the signature for new mail
  73. TitleNew = vCompanyName & " New"
  74. objSignatureEntries.Add TitleNew, objSelection
  75. objSignatureObject.NewMessageSignature = TitleNew
  76.  
  77. ' # Set the signature for reply
  78. TitleReply = vCompanyName & " Reply"
  79. objSignatureEntries.Add TitleReply, objSelection
  80. objSignatureObject.ReplyMessageSignature = TitleReply
  81.  
  82. ' # Save the document
  83. objDoc.Saved = True
  84. objWord.Quit

 

Pour rendre les signatures non modifiables, il suffit d'écrire dans la base de registre les valeurs suivantes (documentation microsoft) :

  1. Dim WshShell
  2. Set WshShell = CreateObject("WScript.Shell")
  3. WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\NewSignature", TitleNew, "REG_EXPAND_SZ"
  4. WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\ReplySignature", TitleReply, "REG_EXPAND_SZ"
  5.  

 


 

Tel quel, le script est déjà fonctionnel. Cependant, on peut lui ajouter quelques fonctionnalités, comme un module pour la création de logs et/ou un module pour l'envoi de mails.

 Voici le module pour la création des logs :

 
  1. ' # Log to file
  2. Set objFSO = CreateObject("Scripting.FileSystemObject")
  3. 'Set myLog = objFSO.OpenTextFile("t:\my.log", 8, True)
  4. Set myLog = objFSO.OpenTextFile(Wscript.ScriptFullName & ".log", 8, True)
  5. 'curDate = Year(Date) & "." & Month(Date) & "." & Day(Date) & " " & Time
  6. curDate = Date & " " & Time
  7. myLog.Write curDate & " * " & sSubject & vbCrlf
  8. myLog.Close
  9.  
  10.  

 


 

Voici la fonction pour l'envoi de mails, à l'administrateur, par exemple, en cas d'anomalie quelconque (données manquantes dans l'AD, etc.) :

 
  1. ' Function to send emails via SMTP server
  2. Function SendMail(sFrom, sTo, sSubject, sHtmlBody)
  3. Dim objMail,objConfig,objFields
  4. Set objMail = CreateObject("CDO.Message")
  5. Set objConfig = CreateObject("CDO.configuration")
  6. Set objFields = objConfig.Fields
  7. With objFields
  8.      .Item("http://schemas.microsoft.com/cdo/configuration/SendUsing")= 2
  9.      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= "smtp.sfrbusinessteam.fr"
  10.      .Item("http://schemas.microsoft.com/cdo/configuration/SMTPServerPort")= 25
  11.      .Update
  12. End With
  13. With objMail
  14.      Set .Configuration = objConfig
  15.          .From = sFrom
  16.          .To = sTo
  17.          .Cc = sCc
  18.          .Bcc = sBcc
  19.          .Subject = sSubject
  20.          .HTMLBody = sHtmlBody
  21.          .Send
  22. End With
  23. End Function
  24.  
  25.  

 

 


 

Et, finalement, voici le script complet :

 
  1.  
  2. ' **********************************************************************
  3. ' Title : FirmaDitta.vbs
  4. ' Description : This VB script automatically creates custom signatures
  5. ' for Microsoft Outlook, from Active Directory, using COM objects
  6. ' Author : Joseph MICACCIA
  7. ' Date : 2016.08.24
  8. ' Version : 1.0
  9. ' **********************************************************************
  10.  
  11. On Error Resume Next
  12.  
  13. ' Function to send emails via SMTP server
  14. Function SendMail(sFrom, sTo, sSubject, sHtmlBody)
  15. Dim objMail,objConfig,objFields
  16. Set objMail = CreateObject("CDO.Message")
  17. Set objConfig = CreateObject("CDO.configuration")
  18. Set objFields = objConfig.Fields
  19. With objFields
  20.      .Item("http://schemas.microsoft.com/cdo/configuration/SendUsing")= 2
  21.      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= "smtp.sfrbusinessteam.fr"
  22.      .Item("http://schemas.microsoft.com/cdo/configuration/SMTPServerPort")= 25
  23.      .Update
  24. End With
  25. With objMail
  26.      Set .Configuration = objConfig
  27.      .From = sFrom
  28.      .To = sTo
  29.      .Cc = sCc
  30.      .Bcc = sBcc
  31.      .Subject = sSubject
  32.      .HTMLBody = sHtmlBody
  33.      .Send
  34. End With
  35. End Function
  36.  
  37. ' # Get user's data from Active Directory
  38. Set objSysInfo = CreateObject("ADSystemInfo")
  39. sUtente = objSysInfo.UserName
  40. Set objUser = GetObject("LDAP://" & sUtente)
  41. uFirstName = objUser.givenName
  42. uName = objUser.sn
  43. uTitle = objUser.Title
  44. uTelephone = "Tel. : " & objUser.TelephoneNumber
  45. if Len(objUser.Mobile)>0 then
  46.        uMobile = " - Mob. : " & objUser.Mobile
  47.    else
  48.        uMobile = ""
  49. end if
  50. uStreet = objUser.StreetAddress
  51. uPostal = objUser.PostalCode
  52. uCity = objUser.l
  53.  
  54. ' # Send email to administrator
  55. sHtmlBody = sUtente &
  56.             "FirstName: " & uFirstName &
  57.             "Name: " & uName &
  58.             "Title: " & uTitle &
  59.             "Telephone: " & uTelephone &
  60.             "Mobile: " & uMobile &
  61.             "Street: "& uStreet &
  62.             "Postal code: " & uPostal &
  63.             "City: " & uCity
  64. sSubject = "Signature automatique pour [" & uFirstName & " " & uName & "]"
  65. Call SendMail("Automatic script ", "Admin ", sSubject, sHtmlBody)
  66.  
  67. ' # Log to file
  68. Set objFSO = CreateObject("Scripting.FileSystemObject")
  69. Set myLog = objFSO.OpenTextFile(Wscript.ScriptFullName & ".log", 8, True)
  70. curDate = Date & " " & Time
  71. myLog.Write curDate & " * " & sSubject & vbCrlf
  72. myLog.Close
  73.  
  74. ' # Create the Word document using COM objects
  75. vBack2Line = chr(11)
  76. vColorBlue = RGB(0,32,96)
  77. vColorGray = RGB(128,128,128)
  78. vCompanyName = "Micaccia"
  79. vCompanyUrl = "www.micaccia.com"
  80. vCompanyLink = "http://www.micaccia.com"
  81. vLogoImage = "\\micaccia.priv\netlogon\FirmaDitta.jpg"
  82. Set objWord = CreateObject("Word.Application")
  83. Set objDoc = objWord.Documents.Add()
  84. Set objSelection = objWord.Selection
  85. Set objEmailOptions = objWord.EmailOptions
  86. Set objSignatureObject = objEmailOptions.EmailSignature
  87. Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
  88. objSelection.Font.Name = "Arial"
  89. objSelection.Font.Size = 10
  90. objSelection.TypeParagraph()
  91. objSelection.Font.Color = vColorBlue
  92. objSelection.TypeText "Cordialement,"
  93. objSelection.TypeText vBack2Line
  94. objSelection.TypeText uFirstName & " "
  95. objSelection.Font.Bold = True
  96. objSelection.TypeText uName
  97. objSelection.Font.Bold = False
  98. objSelection.TypeText vBack2Line
  99. objSelection.TypeText uTitle
  100. objSelection.TypeText vBack2Line
  101. objSelection.Font.Color = vColorGray
  102. objSelection.TypeText uTelephone & uMobile
  103. objSelection.Font.Color = vColorBlue
  104. objSelection.TypeText vBack2Line
  105. objSelection.TypeText uStreet & " - " & uPostal & " " & uCity
  106. objSelection.TypeText vBack2Line
  107. objSelection.TypeText vBack2Line
  108. Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, vCompanyLink,,, vCompanyUrl)
  109. objLink.Range.Font.Color = vColorBlue
  110. objLink.Range.Font.Name = "Arial"
  111. objLink.Range.Font.Size = 10
  112. ObjLink.Range.Font.Bold = true
  113. objSelection.TypeText vBack2Line
  114. objSelection.InlineShapes.AddPicture(vLogoImage)
  115. Set objSelection = objDoc.Range()
  116.  
  117. ' # Set the signature for new mail
  118. TitleNew=vCompanyName & " New"
  119. objSignatureEntries.Add TitleNew, objSelection
  120. objSignatureObject.NewMessageSignature = TitleNew
  121.  
  122. ' # Set the signature for reply
  123. TitleReply=vCompanyName & " Reply"
  124. objSignatureEntries.Add TitleReply, objSelection
  125. objSignatureObject.ReplyMessageSignature = TitleReply
  126.  
  127. ' # Save the document
  128. objDoc.Saved = True
  129. objWord.Quit
  130.  
  131. Dim WshShell
  132. Set WshShell = CreateObject("WScript.Shell")
  133. WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\NewSignature", TitleNew, "REG_EXPAND_SZ"
  134. WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\ReplySignature", TitleReply, "REG_EXPAND_SZ"
  135.  
  136. 'Set objSysInfo = nothing

 

itskills.micaccia.eu:download

 

 

Références et bibliographie :

https://technet.microsoft.com/en-us/library/2006.10.heyscriptingguy.aspx

https://social.technet.microsoft.com/Forums/scriptcenter/en-US/2dc692f1-b51b-453b-b876-50334ca7d6ec/vbscript-how-to-set-the-wanted-file-as-the-outlook-email-signature?forum=ITCG

http://stackoverflow.com/questions/13445538/handling-ms-word-with-vbs-on-windows

http://www.vbsedit.com/scripts/office/word/scr_757.asp

 

 

itskills.micaccia.eu:download PDF

#1  - Yves04 a dit :

exactement ce que je cherchais. merci pour ce code tres clair

Répondre
#2  - get2work@once a dit :

very good job
tanku

Répondre
#3  - merci a dit :

merci

Répondre

Fil RSS des commentaires de cet article

Les commentaires sont fermés.