On Error Resume Next


Set objSysInfo = CreateObject("ADSystemInfo")


strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)


strFullName = objUser.FullName
words = split(strFullname)
strName= words(1)
strSurname=words(0)
strTitle = objUser.Title
strDepartment = objUser.Department
strCompany = objUser.Company
strPhone = objUser.telephoneNumber
strCountry = objUser.co
strZip = objUser.postalCode
strStreet = objUser.streetAddress
strFax= objUser.facsimileTelephoneNumber
strMail=objUser.mail
strCity = objUser.l
strSep = "_______________________"
strHP = objUser.wWWHomepage






strDisclaimer  = "This message may contain confidential and/or legally privileged information and is intended for use by the indicated addressee only. If you are not the intended addressee: (a) any disclosure, reproduction, distribution or action you take on the basis of the contents of this message (except for this instruction) is strictly prohibited; (b) please notify us immediately by reply e-mail and delete this message from your system."






Set objWord = CreateObject("Word.Application")


objword.visible=false
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection


Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature


Set objSignatureEntries = objSignatureObject.EmailSignatureEntries


With objSelection.Font
    .Name = "Verdana"
    .Size = 10
End With


objSelection.TypeText strTitle & " " & strName & " " & strSurname
objSelection.TypeParagraph()
objSelection.TypeText strDepartment 
objSelection.TypeParagraph()
objSelection.TypeText strSep




objSelection.TypeParagraph()
objSelection.TypeText strCompany
objSelection.TypeParagraph()


With objSelection.Font
    .Name = "Verdana"
    .Size = 8
End With




With objSelection.Font
    .Name = "Verdana"
    .Size = 10
End With


objSelection.TypeParagraph()
objSelection.TypeText strStreet & ", " & strZip & " " & strCity & ", " & strCountry
objSelection.TypeParagraph()
objSelection.TypeText "T " & strPhone
objSelection.TypeParagraph()
ObjSelection.TypeText "F " & strFax
objSelection.TypeParagraph()
ObjSelection.TypeText "E " & strMail
objSelection.TypeParagraph()
ObjSelection.TypeText "W " & strHP & vbNewLine
objSelection.TypeParagraph()




    With objSelection.Font
        .Name = "Verdana"
        .Size = 8
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorBlack
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorBlueGray
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With

objSelection.TypeText  strDisclaimer
objSelection.TypeParagraph()
Set objSelection = objDoc.Range()


objSignatureEntries.Add "Signature", objSelection
objSignatureObject.NewMessageSignature = "Signature"
objSignatureObject.ReplyMessageSignature = "Signature"


objDoc.Saved = true
objWord.Quit