Ola Pessoal, com base nas informações do forum criei com sucesso um script para criar assinatura padrao no Outlook 2003, 2007 e 2010. Porém estou com problemas em adapta-lo para a versão do Outlook 2000. Segue abaixo o script
que conforme informações funcionariam na versão 2000, porem ocorre erro na hora de gravar as informações, como se não reconhece-se RTF, HTML e DOC. Se alguem puder ajudar agradeço...
' VBScript source code
' Pagina base da procura de informações do script: http://social.technet.microsoft.com/Forums/pt-BR/scriptadminpt/thread/a591403a-796a-4a45-872d-febe44265e34
On Error Resume Next
Const RTF = 6
Const Text = 4
Const HTML = 8
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strFirstName = objuser.givenName
StrLastName = objuser.sn
strTitle = objUser.Title
srtDepartament = objUser.department
strCompany = objUser.Company
strStreet = objUser.StreetAddress
strLocation = objUser.l
strCountry = objUser.co
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strWeb = "www.site.com.br"
' Caminho para buscar o logo da empresa
strLogo = "\\script\Assinatura_Out\logo.jpg"
set outlook = createobject("outlook.application")
Set wshShell = WScript.CreateObject("WScript.Shell" )
StrProfile = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")+"\Application Data\Microsoft\Signatures\"
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
' Definicao das cores que podem ser usadas na assinatura
wdColorAqua = 13421619
wdColorAutomatic = -16777216
wdColorBlack = 0
wdColorBlue = 16711680
wdColorBlueGray = 10053222
wdColorBrightGreen = 65280
wdColorBrown = 13209
wdColorDarkBlue = 8388608
wdColorDarkGreen = 13056
wdColorDarkRed = 128
wdColorDarkTeal = 6697728
wdColorDarkYellow = 32896
wdColorGold = 52479
wdColorGray05 = 15987699
wdColorGray10 = 15132390
wdColorGray125 = 14737632
wdColorGray15 = 14277081
wdColorGray20 = 13421772
wdColorGray25 = 12632256
wdColorGray30 = 11776947
wdColorGray35 = 10921638
wdColorGray375 = 10526880
wdColorGray40 = 10066329
wdColorGray45 = 9211020
wdColorGray50 = 8421504
wdColorGray55 = 7566195
wdColorGray60 = 6710886
wdColorGray625 = 6316128
wdColorGray65 = 5855577
wdColorGray70 = 5000268
wdColorGray75 = 4210752
wdColorGray80 = 3355443
wdColorGray85 = 2500134
wdColorGray875 = 2105376
wdColorGray90 = 1644825
wdColorGray95 = 789516
wdColorGreen = 32768
wdColorIndigo = 10040115
wdColorLavender = 16751052
wdColorLightBlue = 16737843
wdColorLightGreen = 13434828
wdColorLightOrange = 39423
wdColorLightTurquoise = 16777164
wdColorLightYellow = 10092543
wdColorLime = 52377
wdColorOliveGreen = 13107
wdColorOrange = 26367
wdColorPaleBlue = 16764057
wdColorPink = 16711935
wdColorPlum = 6697881
wdColorRed = 255
wdColorRose = 13408767
wdColorSeaGreen = 6723891
wdColorSkyBlue = 16763904
wdColorTan = 10079487
wdColorTeal = 8421376
wdColorTurquoise = 16776960
wdColorViolet = 8388736
wdColorWhite = 16777215
wdColorYellow = 65535
' Inicio da Assinatura
'Nome completo do Usuario
objSelection.Font.Name = "Calibri"
objSelection.Font.Size = "11"
objSelection.Font.Color = wdColorBlack
objSelection.Font.Bold = True
objSelection.TypeText strName & VbCr
objSelection.Font.Bold = False
objSelection.Font.Size = "11"
objSelection.Font.Color = wdColorBlack
'objSelection.TypeText "" & VbCr
'objSelection.TypeText "" &VbCr
objSelection.Font.Bold = False
objSelection.Font.Color = wdColorGray35
'Departamento
'objSelection.TypeText srtDepartament & VbCr
'Remove os primeiros 11 caracteres e mostra os proximos 100
objSelection.TypeText Mid(srtDepartament, 11,100) & VbCr
'Define as cores dos próximos dados
objSelection.Font.Color = wdColorBlack
'Telefone
objSelection.TypeText "Fone: " & strPhone & VbCr
if trim(strfax) <> "" then
objSelection.TypeText " Fax: " & strFax & VbCr
end if
'E-mail
'objSelection.TypeText " e-mail: " & strEmail & VbCr
'Endereço Web Empresa
objSelection.TypeText strWeb & VbCr
'Logotipo Empresa
objTable.Cell(1, 1).Range.Text = objSelection.InlineShapes.AddPicture(strLogo)
objTable.Columns(1).Width = objWord.InchesToPoints(1)
objSelection.TypeText Chr(11)
Set objSelection = objDoc.Range()
objDoc.SaveAs strProfile & "Default.rtf", RTF
objDoc.SaveAs strProfile & "Default.txt", Text
objDoc.SaveAs strProfile & "Default.htm", HTML
objWord.Quit
A aplicação não reconhece essas informações:
objDoc.SaveAs strProfile & "Default.rtf", RTF
objDoc.SaveAs strProfile & "Default.txt", Text
objDoc.SaveAs strProfile & "Default.htm", HTML
Referencias deste comando encontradas em: http://telnetport25.wordpress.com/2007/07/25/update-to-adding-outlook-signatures-outlook-2000-fix
Alguem tem alguma dica, e se já tiverem passado por isso, existe como definir a assinatura já como padrao para o usuario?
Obrigado
Jeferson
