On Error Resume Next Set objSysInfo = CreateObject("ADSystemInfo") strUser = objSysInfo.UserName Set objUser = GetObject("LDAP://" & strUser) With objUser strName = .FullName ' strTitle = .Description End With 'strCompany = objUser.Company 'strAddress = objUser.streetAddress 'strpostalCode = objUser.postalCode 'strl = objUser.l 'strco = objUser.co 'strPhone = objUser.TelephoneNumber 'strFax = objUser.facsimileTelephoneNumber 'strMail = objuser.mail 'strWeb = objuser.wWWHomePage Set objword = CreateObject("Word.Application") With objword Set objDoc = .Documents.Add() Set objSelection = .Selection Set objEmailOptions = .EmailOptions End With Set objSignatureObject = objEmailOptions.EmailSignature Set objSignatureEntries = objSignatureObject.EmailSignatureEntries With objSelection .ParagraphFormat.Alignment = wdAlignParagraphRight .TypeParagraph With .Font .Name = "Verdana" .Size = 14 .Bold = false End With .TypeText strName & Chr(14) .InlineShapes.AddPicture "\\zeus\NETLOGON\sari.jpg", True, True With .Font .Name = "Verdana" .Size = 14 .Bold = False .Italic = False End With .TypeText strTitle & Chr(11) .TypeText Chr(11) objSelection.Font.Size = "14" objSelection.Font.Name = "verdana" objSelection.Font.Bold = True objSelection.TypeText strCompany objSelection.Font.Bold = True .TypeText Chr(14) With .Font .Name = "Verdana" .Size = 14 .Bold = false End With ' .Font.Italic = False ' .TypeText "Tel: +55 " & strPhone & Chr(11) & "Tel: +55 " & strFax & Chr(11) & "E-mail: " & strMail & Chr(11) & "Site: http://" & strWeb & Chr(11) ' .TypeText Chr(10) .TypeText Chr(11) .TypeText Chr(11) objSelection.Font.Size = "8" objSelection.Font.italic = true objSelection.Font.Color = 8421504 objSelection.Font.Bold = False objSelection.TypeText "Esta mensagem pode conter informação confidencial e/ou privilegiada. Se você não for o destinatário ou a pessoa autorizada a receber esta mensagem, não pode usar, copiar ou divulgar as informações nela contidas ou tomar qualquer ação baseada nessas informações. Se você recebeu esta mensagem por engano, por favor, avise imediatamente o remetente, respondendo o e-mail, e em seguida apague-o. Agradecemos sua cooperação." .TypeText Chr(11) .TypeText Chr(11) objSelection.Font.Size = "8" objSelection.Font.italic = true objSelection.Font.Color = 8421504 objSelection.Font.Bold = False objSelection.TypeText "This message may contain confidential and/or privileged information. If you are not the address or authorized to receive this for the address, you must not use, copy, disclose or take any action base on this message or any information herein. If you have received this message in error, please advise the sender immediately by reply e-mail and delete this message. Thank you for your cooperation" End With Set objSelection = objDoc.Range() objSignatureEntries.Add "sari", objSelection objSignatureObject.NewMessageSignature = "sari" objSignatureObject.ReplyMessageSignature = "sari" objDoc.Saved = True objword.Quit