Creation de signature Outlook

**tkwebch** · 22/08/2012, 13h49

Bonjour,

J'utilise ce script VBS pour créer une signature dans Outlook à l'ouverture de session

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
On Error Resume Next
 
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
strName = objUser.FullName
strTitle = objUser.Title 
'strDepartment = objUser.Department
'strCompany = objUser.Company
'strPhone = objUser.telephoneNumber
 
Set objWord = CreateObject("Word.Application")
objWord.Visible = TRUE
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Style = "No Spacing"
 
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
 
'Name of Staff
objSelection.Font.Name = "Calibri"
objSelection.Font.Bold = True
objSelection.Font.Size = "12"
objSelection.Font.Color = RGB(15,36,62)
objSelection.TypeText strName
objSelection.TypeText(Chr(11))
 
'Role of Staff
objSelection.Font.Name = "Calibri"
objSelection.Font.Bold = False
objSelection.Font.Size = "11"
objSelection.Font.Color = 0
objSelection.TypeText strTitle
objSelection.TypeText(Chr(11))
 
 
objSelection.TypeParagraph()
 
'Company Contact details
objSelection.Font.Color = RGB(38,38,38)
objSelection.TypeText "Tel +44 (0) 744 525 5214"
objSelection.TypeText(Chr(11))
objSelection.TypeText "Fax +44 (0) 744 524 2244"
objSelection.TypeText(Chr(11))
objSelection.Font.Color = RGB(23,54,93)
 
objSelection.TypeParagraph()
 
 
'environment message
objSelection.Font.Name = "Webdings"
objSelection.Font.Size = "14"
objSelection.Font.Color = RGB(115,155,63)
objSelection.TypeText "P "
objSelection.Font.Name = "Calibri"
objSelection.Font.Size = "9"
objSelection.TypeText "Please consider the environment before printing this e-mail."
 
Set objSelection = objDoc.Range()
objDoc.SaveAs "F:\tests.doc"
'MsgBox "ok"
 
objSignatureEntries.Add "test5", objSelection
objSignatureObject.NewMessageSignature = "test5"
objSignatureObject.ReplyMessageSignature = "test5"
 
objDoc.Saved = True
 
'objDoc.SaveAs "F:\tests2.doc"
objWord.Quit