1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
'Affiche une fenetre pour demander l'approbation de l'utilisateur Si il reponds Non fin du script
Set WshShell = WScript.CreateObject("WScript.Shell")
Lancer = MsgBox("Voulez vous avoir la signature xxxxx?",vbYesNo,"Signature xxxx")
If Lancer = vbNo Then
Wscript.Quit
End If
'Prends les informations sur l'active Directory
Set objSysInfo = CreateObject("ADSystemInfo")
sUtente = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & sUtente)
'Déclaration de la variable
uTitle = objUser.Title
uTelephone = objUser.TelephoneNumber
uMobile = objuser.Mobile
'Demande à l'utilisateur de confirmer sa fonction ou de la modifier
uDepartement = InputBox("Merci de modifier l'intitule de votre poste, si necessaire ? ","Signature xxxxx", uTitle)
'Faire valider le numéro par l'utilisateur
uTelephone = InputBox("Merci de confirmer ou modifier le numéro de telephone", "Signature xxxxxx", uTelephone)
umobile = InputBox("Merci de confirmer ou modifier le numéro de telephone", "Signature xxxxxx", umobile)
'uStreet = InputBox("Indiquez l'emplacement de votre site",vb"Exemple: rue de provence" )
WshShell.Popup "Merci de bien vouloir redemarrer Outlook "
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
' # Prends les informations des users sur l'active Directory
Set objSysInfo = CreateObject("ADSystemInfo")
sUtente = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & sUtente)
uFirstName = objUser.givenName
uName = objUser.sn
'uTitle = objUser.Title
if Len(umobile)>0 Then
uMobile = "Mob: " & umobile
else
uMobile = ""
end if
uMail = objUser.mail
uStreet = objUser.StreetAddress
uPostal = objUser.PostalCode
uCity = objUser.l
uDepartement 'Pour afficher le departement des users ex: Direction informatique Production Systemes
' # 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 <xxx@>", "Admin <xxxx@>", 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 Back2Line = chr(11)
vBack2Line = chr(11)
vColorBlack = RGB(0,0,0) '6299648
'vColorGray = RGB(128,128,128) '8418944
'vCompanyName = "xxxxx"
'vCompanyUrl = "www.xxxx.com"
'vCompanyLink = "http://www.xxxxx.com"
If uStreet = "98 rue de la xxxx" Then
vLogoImage = "https://xxx.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 = "xxxxx 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 = "xxxxx Sans Light"
objSelection.Font.Size = 10
objSelection.TypeText vBack2Line
'objSelection.TypeText uTitle
'objSelection.TypeText vBack2Line
objSelection.TypeText uDepartement 'Youssef
objSelection.TypeText vBack2Line
objSelection.Font.Color = vcolorBlack 'vColorGray
objSelection.TypeText "Tel:" & uTelephone
If Len(umobile)>0 Then
objSelection.TypeText vBack2Line
objSelection.Typetext uMobile
else
uMobile = ""
End if
objSelection.Font.Color = vColorBlack'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 = "xxxx Sans Light" readhost
'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 & " Signature xxxxx Envoie "
objSignatureEntries.Add TitleNew, objSelection
objSignatureObject.NewMessageSignature = TitleNew
' # Set the signature for reply
TitleReply=vCompanyName & " Signature xxxxx Reponse"
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 |
