none
Script Assinatura Outlook 2000 RRS feed

  • Pergunta

  • 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

    • Editado JefersonL quinta-feira, 4 de novembro de 2010 15:00 Update
    quinta-feira, 4 de novembro de 2010 13:43