Bazı durumlarda şirket içerisinde herkese belirli formatta bir imza eklememiz gerekebilir. Bunu maalesef Excahnge Server üzerinden yapamıyoruz. Transport rule lar ile maillerin sonuna disclaimer eklenebiliyor ancak kullanıcıya özel bilgi ekleyemiyoruz.
Bunu yapmanın yolu VBscriptten geçiyor. Tabi bunuda kullanabilmeniz için Active Directory ortamında kişilerin bilgilerinin tam girilmiş olması gerekmekte.
Aşağıda ilgili kodu bulabilirsiniz ve kendinize göre düzenleyebilirsiniz.
Emeği geçen Bilgin Işık arkadaşıma da ayrıca teşekkür ederim..
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
strStreet = objUser.streetAddress
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
Dim name,firstLetter,otherLetters,fname,sname
name = strName
arr = Split(name, ” “)
firstLetter=UCase(Left(arr(0),1))
otherLetters=LCase(Right(arr(0),Len(arr(0))-1))
fname=firstLetter & otherLetters
firstLetter=UCase(Left(arr(1),1))
otherLetters=LCase(Right(arr(1),Len(arr(1))-1))
sname=firstLetter & otherLetters
name =fname & ” ” & sname
With objSelection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1.15)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With With objSelection
.Font.Bold = True
.TypeText name
.TypeText vbCRLF
.TypeText strTitle
.TypeText vbCRLF
.TypeText strDepartment & ” Department”
.TypeText vbCRLF
.TypeText vbCRLF
.Font.Color = vbRed
.TypeText strCompany
.TypeText vbCRLF
.Font.Bold = True
.Font.Color = vbBlack
.TypeText “Phone : ”
.Font.Bold = False
.TypeText strPhone
.TypeText vbCRLF
.Font.Bold = True
.TypeText “Address : ”
.Font.Bold = False
.TypeText vbCRLF
.TypeText strStreet
End With
Set objSelection = objDoc.Range()
IF(objSignatureEntries(“AD Signature”)) THEN
objSignatureEntries.Remove “AD Signature” END IF
objSignatureEntries.Add “AD Signature”, objSelection
objSignatureObject.NewMessageSignature = “AD Signature”
objSignatureObject.ReplyMessageSignature = “AD Signature”
objDoc.Saved = True
objWord.Quit
Twitter
Facebook
LinkedIn
GooglePlus
Email