Microsoft Exchange: firme per Outlook con VBS, Active Directory e GPO

Pubblicato da Giuseppe MICACCIA - -
itskills.micaccia.eu:Signature automatique pour Microsoft Outlook

Avevo bisogno di uno script per gestire le firme in Outlook. Guardando sull'Internet ho visto subito che non ero da solo a cercarlo.


Così, ho raccolto alcuni pezzi di codice qua e là. Poi, con quello che mi è sembrato essere il migliore, ho fatto una sintesi.

 

itskills.micaccia.eu:outlook signatures

 

Avrei voluto menzionare il nome degli autori dei pezzi di script, trovati qua e là. Non avendo i nomi, nella sezione "Riferimenti e Bibliografia", ho citato alcuni dei siti web in cui ho trovato la mia ispirazione.

Metto i risultati finali sull'Internet, in caso possa essere utile a qualcuno.

Siete liberi di fare tutto cio che volete con questo script. E, se volete, potete anche citare la fonte, itskills.micaccia.eu.

 

"FirmaDitta"

 


 

Per quanto riguarda lo script per la firma di Outlook, deveva soddisfare i seguenti criteri:

  •      creazione automatica della firma in Outlook, utilizzando Active Directory e i GPO
  •      rispettare la carta grafica della società (font, colori, ecc)
  •      contenere un link web (sito della ditta) e un'immagine (logo aziendale)
  •      Non essere modificato dall'utente


Ecco lo 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

 

Per rendere le firme immutabili, basta scrivere nel Registro di sistema i seguenti valori (documentazione 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.  

 


 

Come tale, lo script è già funzionale. Tuttavia, si può aggiungere alcune caratteristiche, come ad esempio un modulo per i log e/o un modulo per l'invio delle email.

Ecco il modulo per i log:

 
  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.  

 


 

Ecco la funzione per inviare le email all'amministratore, ad esempio, in caso di anomalia (dati mancanti nell'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.  

 

 


 

E, infine, ecco lo script completo:

 
  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 ha detto :

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

Rispondere
#2  - get2work@once ha detto :

very good job
tanku

Rispondere

Feed dei commenti di questo articolo

Commenti bloccati.