Script pour signatures outlook erreur
Script pour signatures outlook erreur - VB/VBA/VBS - Programmation
Marsh Posté le 14-06-2018 à 14:48:24
Bonjour youssefduafg,
Je fais suite à votre demande. Je suis l'auteur de ce script et je peux vous aider à l'adapter en fonction de vos besoins.
Merci de préciser l'erreur qui s'affiche après vos modifications.
Je reste à votre écoute, soit sur ce site, soit directement via le formulaire de contact du site où vous avez trouvé le script.
A bientôt,
Cordialement
Marsh Posté le 21-06-2018 à 10:27:23
| josephm a écrit : Bonjour youssefduafg, |
Bonjour JosphM
Depuis je me suis inspiré de ton script et d'autres script mais j'ai toujours besoin d'aide pour le finir si vous êtes disponible cette semaine ou ce week end merci de m'envoyer un message privée
Mon nouveau script ou j'aimerais intégrer des fenêtres personnalisé au couleurs de mon entreprise et textbox de saisie pour faire modifier certaines variables par l’utilisateur.
Voici un processus qui explique mon besoin.
| Spoiler : #variables |
Sujets relatifs:
- erreur avec free()
- Script JAVA sous Google SHEETS
- script pour changer les paramètres windows
- Script pour tester méthodes casino
- [Résolu] VB script : Conversion Str en Int
- Affichage message erreur mot de passe
- Un script pour deux pages
- login/mot de passe dans script ftp dans dos
- [VB] Erreur si utilisation d'un ContextMenuStrip
- Problème MFC en VBA (erreur -2147417848 (80010108) )
Marsh Posté le 14-11-2017 à 10:20:05
Bonjour a tous,
Je cherchais un script pour creer une signature outlook automaitque a partir des informations enrengistrés sur l'active Directory
J'ai modifié mais j'ai une erreur car j'ai essayé de créer une instruction Si ou il va récupérer l'adresse postale dans l'ad avec objUser.StreetAddress et si l'adresse correspond il récupère l'image et la place dans vLogoImage.
Tout me semble bon mais lors de l’exécution du script il m'affiche une erreur.
Si quelqu'un s'y connait et peut m'aider je le remercie.
Ps le code est dans spoilier et en gras ce que j'ai modifié.
' **********************************************************************
' Title : FirmaDitta.vbs
' Description : This VB script automatically creates custom signatures
' for Microsoft Outlook, from Active Directory, using COM objects
' Author : Joseph MICACCIA
' Date : 2016.08.24
' Version : 1.0
' **********************************************************************
On Error Resume Next
' Function to send emails via SMTP server
Function SendMail(sFrom, sTo, sSubject, sHtmlBody)
Dim objMail,objConfig,objFields
Set objMail = CreateObject("CDO.Message" )
Set objConfig = CreateObject("CDO.configuration" )
Set objFields = objConfig.Fields
With objFields
.Item("http://schemas.microsoft.com/cdo/configuration/SendUsing" )= 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver" )= "smtp.sfrbusinessteam.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/SMTPServerPort" )= 25
.Update
End With
With objMail
Set .Configuration = objConfig
.From = sFrom
.To = sTo
.Cc = sCc
.Bcc = sBcc
.Subject = sSubject
.HTMLBody = sHtmlBody
.Send
End With
End Function
' # Get user's data from Active Directory
Set objSysInfo = CreateObject("ADSystemInfo" )
sUtente = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & sUtente)
uFirstName = objUser.givenName
uName = objUser.sn
uTitle = objUser.Title
uTelephone = "Tel. : " & objUser.TelephoneNumber
if Len(objUser.Mobile)>0 then
uMobile = " - Mob. : " & objUser.Mobile
else
uMobile = ""
end if
uMail = objUser.mail
uStreet = objUser.StreetAddress
uPostal = objUser.PostalCode
uCity = objUser.l
' # Send email to administrator
sHtmlBody = sUtente & "<br/>FirstName: " & uFirstName & "<br/>Name: " & uName & "<br/>Title: " & uTitle & "<br/>Telephone: " & uTelephone & "<br/>Mobile: " & uMobile & "<br/>Street: " & uStreet & "<br/>Postal code: " & uPostal & "<br/>City: " & uCity
sSubject = "Signature automatique pour [" & uFirstName & " " & uName & "]"
Call SendMail("Automatic script <yafker@printemps.fr>", "Admin <yafker@printemps.fr>", sSubject, sHtmlBody)
' # Log to file
Set objFSO = CreateObject("Scripting.FileSystemObject" )
'Set myLog = objFSO.OpenTextFile("t:\my.log", 8, True)
Set myLog = objFSO.OpenTextFile(Wscript.ScriptFullName & ".log", 8, True)
'curDate = Year(Date) & "." & Month(Date) & "." & Day(Date) & " " & Time
curDate = Date & " " & Time
myLog.Write curDate & " * " & sSubject & vbCrlf
myLog.Close
' # Create the Word document using COM objects
vBack2Line = chr(11)
vColorBlack = RGB(0,0,0) '6299648
vColorGray = RGB(128,128,128) '8418944
'vCompanyName = "Printemps"
'vCompanyUrl = "www.printemps.com"
'vCompanyLink = "http://www.printemps.com"
If objUser.Streetaddress ="98 rue de la victoire" Then
vLogoImage = "https://printempso365.sharepoint.com/sites/planete/PublishingImages/COMMUNICATION/MODELES-ET-CHARTES/SIGNATURES/SIEGE/Signature%20Printemps%20-%20Si%C3%A8ge%20Victoire.jpg"
Else If objUser.Streetaddress ="haussman" Then
vLogoImage = "https://printempso365.sharepoint.com/sites/planete/PublishingImages/COMMUNICATION/MODELES-ET-CHARTES/SIGNATURES/HAUSSMANN/Signature%20Printemps%20-%20ouverture%20dimanche.jpg"
Else
vLogoImage ="https://printempso365.sharepoint.com/sites/planete/PublishingImages/COMMUNICATION/MODELES-ET-CHARTES/SIGNATURES/HAUSSMANN/Signature%20Printemps%20-%20ouverture%20dimanche%20-%20Anglais.jpg"
End if
Set objWord = CreateObject("Word.Application" )
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSelection.Font.Name = "Printania Sans"
objSelection.Font.Size = 10
objSelection.TypeParagraph()
objSelection.Font.Color = vColorBlack
'objSelection.TypeText "Cordialement,"
objSelection.TypeText vBack2Line
objSelection.Font.Bold = True 'youssef
objSelection.TypeText uFirstName & " "
'objSelection.Font.Bold = True
objSelection.TypeText uName
objSelection.Font.Bold = False
objSelection.Font.Name = "Printania Sans Light"
objSelection.Font.Size = 10
objSelection.TypeText vBack2Line
objSelection.TypeText uTitle
objSelection.TypeText vBack2Line
objSelection.Font.Color = vColorGray
objSelection.TypeText uTelephone & uMobile
objSelection.Font.Color = vColorGray
objSelection.TypeText vBack2Line
objSelection.TypeText uMail'youssef
objSelection.TypeText vBack2Line
objSelection.TypeText uStreet & " - " & uPostal & " " & uCity
'objSelection.TypeText vBack2Line
'objSelection.TypeText vBack2Line
'Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, vCompanyLink,,, vCompanyUrl)
'objLink.Range.Font.Color = vColorBlue
'objLink.Range.Font.Name = "Printania Sans Light"
'objLink.Range.Font.Size = 10
'ObjLink.Range.Font.Bold = true
objSelection.TypeText vBack2Line
objSelection.InlineShapes.AddPicture(vLogoImage)
Set objSelection = objDoc.Range()
' # Set the signature for new mail
TitleNew=vCompanyName & " New"
objSignatureEntries.Add TitleNew, objSelection
objSignatureObject.NewMessageSignature = TitleNew
' # Set the signature for reply
TitleReply=vCompanyName & " Reply"
objSignatureEntries.Add TitleReply, objSelection
objSignatureObject.ReplyMessageSignature = TitleReply
' # Save the document
objDoc.Saved = True
objWord.Quit
Dim WshShell
Set WshShell = CreateObject("WScript.Shell" )
WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\NewSignature", TitleNew, "REG_EXPAND_SZ"
WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\ReplySignature", TitleReply, "REG_EXPAND_SZ"
'WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\General\Signatures", "Signatures", "REG_SZ"
'WshShell.RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrrentVersion\Explorer\TypedPaths\url3", "%userprofile%\Application Data\Microsoft\Signatures", "REG_SZ"
'Set objSysInfo = nothing