none
Script Assinatura de E-mail RRS feed

  • Pergunta

  • Boa tarde pessoal,

     Tenho um script onde eu consigo definir uma assinatura de e-mail para a conta do Outlook conforme os padrões da empresa. Este funciona muito bem, porém, foi solicitada uma mudança para inserir um QRCold na Assinatura. O QRcold vai ser gerado pelo usuario que vai ficar no Disco Local da maquina C:\ em formato qrcold.png. O problema é a localização da Imagem que tem que ficar do lado esquerdo do nome, cargo, telefone e etc...

     Realizei algumas alterações sem sucesso.

    Se alguém puder ajudar, segue abaixo o script:

    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
    strDescription = objuser.Description


    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

       With .ParagraphFormat
           .LineSpacingRule = wdLineSpaceSimple
           .SpaceAfter = 0
       End With
      .TypeText Chr(11)

      With .Font
        .Name = "Calibri"
        .Size = 11
        .Bold = false
      End With
       .TypeText "Atenciosamente,"
      .TypeText Chr(11)
      .TypeText Chr(11)

      With .Font
        .Name = "Calibri"
        .Size = 11
        .Bold = true
        .Italic = true
      End With
        .TypeText strName & chr(11)
      With .Font
        .Name = "Calibri"
        .Size = 11
        .Bold = False
        .Italic = False
      End With
     
      .TypeText strDescription & chr(11)
      With .Font
        .Name = "Calibri"
        .Size = 11
        .Bold = False
        .Italic = False
      End With  
     
     
     
      .TypeText "Msn/e-mail: "
      Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto:" + strMail,,"Ibyte",strMail)
      .TypeText Chr(11)
      With .Font
        .Name = "Calibri"
        .Size = 11
        .Bold = false
      End With
        .Font.Italic = False
        a = ""
        Z = MsgBox ("ATENÇÃO!!!! LEIA AS INFOMAÇÕES A SEGUIR ATENTAMENTE!!!!! GRATO DTI", 48, "INFORMAÇÃO IMPORTANTE - IBYTE - DTI")
        msgbox("Por favor Preencha as informações a seguir para que sua assinatura de email seja Atualizada. Caso não use OUTLOOK Informe 0 na Primeira Janela. PROCESSO OBRIGATORIO PARA USUARIO DE OUTLOOK. DÚVIDAS LIGUE 7734 GRATO DTI")
        Do While (((Mid(a, 3, 1) <> " " or Mid(a, 8, 1) <> "-") or ((len(trim(a))<12 or len(trim(a))> 12))) and a<> "0" )
            a=inputbox("Digite seu Telefone FIXO no formato XX XXXX-XXXX (EXEMPLO: 85 4444-4444). Para sair digite 0. Ao sair a assinatura não será concluída.","Telefone")
        Loop
        
        if (a="0") Then Wscript.Quit
        
        Do While (((Mid(b, 3, 1) <> " " or Mid(b, 8, 1) <> "-") or ((len(trim(b))<12 or len(trim(b))> 12))) and b<> "0" )
            b=inputbox("Digite seu Celular CORPORATIVO no formato XX XXXX-XXXX (EXEMPLO: 85 8888-8888) NÃO COLOQUE CELULAR PESSOAL. Se não possuir celular coorporativo, digite 0 para avançar.","Celular")
        Loop
        
        if (b<> "0") Then
            a = a + " / +55 " + b
        End If
        
        c = "1"
        d = "2"
        Do While ((trim(lcase(c)) <> trim(lcase(d))) and (c<>"0" and d<> "0"))
            c = inputbox("Informe o email de seu SUPERIOR IMEDIATO (Supervisor, ou, Gerente, ou Diretor), ou informe 0, caso não possua um superior imediato, ou seja um GERENTE, ou, DIRETOR.", "Superior imediato")
            d = inputbox("CONFIRME o email de seu superior imediato (Supervisor, ou, Gerente, ou Diretor), ou informe 0, caso não possua um superior imediato, ou seja um GERENTE, ou, DIRETOR", "Superior imediato")
        Loop
        

        .TypeText strAddress & "Fone: +55 " & a
        .TypeText Chr(11)
         Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, strWeb,,"Ibyte",strWeb)
        .TypeText Chr(11)
        .InlineShapes.AddPicture "C:\qrcold.png", True, True
        .InlineShapes.AddPicture "\\192.168.0.50\netlogon\img\ibt.gif", True, True
        

        if (c = d and c<> "0") Then
            .TypeText Chr(11)
            e = "Como está o meu atendimento? Envie seus comentários para o meu Gerente, através do e-mail "
            With .Font
                .Name = "Calibri"
                .Bold = true
                .Size = 11
                .Italic = true
            End With
            .TypeText e
            Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " + c,,"Ibyte",c)
        End If
        
        .TypeText Chr(11)
        objSelection.Font.Size = "9"
        objSelection.Font.italic = true
        objSelection.Font.Color = 000
        objSelection.Font.Bold = False  
        objSelection.Font.Name = "Calibri"
        objSelection.TypeText "Esta mensagem e os arquivos nela contidos são confidenciais e legalmente protegidos, somente podendo ser usados pelo indivíduo ou entidade a quem foi endereçada. Caso você a tenha recebido por engano, queira por gentileza devolvê-la ao remetente e, posteriormente, apagá-la, pois a disseminação, encaminhamento, uso, impressão ou cópia do conteúdo desta mensagem são expressamente proibidos."
        
        .TypeText Chr(11)
        objSelection.Font.Size = "28"
        objSelection.Font.italic = false
        objSelection.Font.Color = 26112    
        objSelection.Font.Bold = False
        objSelection.Font.Name = "Webdings"
        objSelection.TypeText "P"
        
        objSelection.Font.Size = "10"
        objSelection.Font.italic = false
        objSelection.Font.Color = 26112    
        objSelection.Font.Bold = False
        objSelection.Font.Name = "Arial, sans-serif"
        objSelection.TypeText " Antes de imprimir, pense em sua responsabilidade com a redução de custos, e compromisso com o MEIO AMBIENTE."


      End With

    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "AD Signature", objSelection
    objSignatureObject.NewMessageSignature = "AD Signature"
    objSignatureObject.ReplyMessageSignature = "AD Signature"
    objDoc.Saved = True

    msgbox ("Obrigado! Assinatura criada com sucesso!")
    objword.Quit
    quinta-feira, 9 de fevereiro de 2012 20:37

Respostas

Todas as Respostas

  • Bom dia, 

    No caso teria como bloquear a ediçao deste arquivo pelo usuario ?


    Benedito Jr

    sexta-feira, 10 de fevereiro de 2012 11:11
  • Galera realizei uns avanços  no script porém, ainda tem alguns ajuste que não estou conseguindo realizar.

    A segunda imagem está ficando distante das informações nome, telefone etc.

    Outro é que não consigo tratar individualmente a fonte do  nome, telefone etc.

    segue o script:

    Const END_OF_STORY = 6
    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
    strDescription = objuser.Description


    Set objword = CreateObject("Word.Application")
    With objword

      Set objDoc = .Documents.Add()
      Set objSelection = .Selection
      Set objEmailOptions = .EmailOptions
     
      Set objRange = objDoc.Range()
      objDoc.Tables.Add objRange,1,2
      Set objTable = objDoc.Tables(1)

    End With

    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    With objSelection
    objTable.Rows.Add()

         objDoc.Hyperlinks.Add objSelection.InlineShapes.AddPicture("c:\qrcold.png"), strweb
        
        'a' Armazena o Número de Telefone fornecida pelo usuario.
         a=inputbox("Digite seu Telefone FIXO no formato XX XXXX-XXXX (EXEMPLO: 85 3333-3333). Para sair digite 0. Ao sair a assinatura não será concluída.","Telefone")
         'b' Celular
         b=inputbox("Digite seu Celular CORPORATIVO no formato XX XXXX-XXXX (EXEMPLO: 85 3333-1234) NÃO COLOQUE CELULAR PESSOAL. Se não possuir celular coorporativo, digite 0 para avançar.","Celular")
         'c ' Informação Superior imediato
         c = inputbox("Informe o email de seu SUPERIOR IMEDIATO (Supervisor, ou, Gerente, ou Diretor), ou informe 0, caso não possua um superior imediato, ou seja um GERENTE, ou, DIRETOR.", "Superior imediato")
        .ParagraphFormat.Alignment = wdAlignParagraphRight
        .TypeParagraph
     
        objTable.Cell(1, 2).Range.Font.Bold = true
        objTable.Cell(1, 2).Range.Font.italic = true
        objTable.Cell(1, 2).Range.Font.Size = "11"
        objTable.Cell(1, 2).Range.Font.Name = "Calibri"
        objTable.Columns(1).Width = objWord.InchesToPoints(1)
        objTable.Cell(1, 2).Range.Text = strName & Chr(11) & strDescription & Chr(11) & "Msn/e-mail: " + strMail & Chr(11) & "Fone: +55 " + a + " / " + b  & Chr(11) & strWeb & Chr(11)
     objSelection.EndKey END_OF_STORY
     
    objSelection.InlineShapes.AddPicture("\\192.168.0.50\netlogon\img\ibt.gif")
    '.InlineShapes.AddPicture "\\192.168.0.50\netlogon\img\ibt.gif", True, True


    .TypeText Chr(11)
            e = "Como está o meu atendimento? Envie seus comentários para o meu Gerente, através do e-mail "
            With .Font
                .Name = "Calibri"
                .Bold = true
                .Size = 11
                .Italic = true
            End With
            .TypeText e
            Set objLink = objSelection.Hyperlinks.Add(objSelection.Range, "mailto: " + c,,"Ibyte",c)

        .TypeText Chr(11)
        objSelection.Font.Size = "9"
        objSelection.Font.italic = true
        objSelection.Font.Color = 000
        objSelection.Font.Bold = False  
        objSelection.Font.Name = "Calibri"
        objSelection.TypeText "Esta mensagem e os arquivos nela contidos são confidenciais e legalmente protegidos, somente podendo ser usados pelo indivíduo ou entidade a quem foi endereçada. Caso você a tenha recebido por engano, queira por gentileza devolvê-la ao remetente e, posteriormente, apagá-la, pois a disseminação, encaminhamento, uso, impressão ou cópia do conteúdo desta mensagem são expressamente proibidos."

        
        .TypeText Chr(11)
        objSelection.Font.Size = "28"
        objSelection.Font.italic = false
        objSelection.Font.Color = 26112    
        objSelection.Font.Bold = False
        objSelection.Font.Name = "Webdings"
        objSelection.TypeText "P"
        
        objSelection.Font.Size = "10"
        objSelection.Font.italic = false
        objSelection.Font.Color = 26112    
        objSelection.Font.Bold = False
        objSelection.Font.Name = "Arial, sans-serif"
        objSelection.TypeText " Antes de imprimir, pense em sua responsabilidade com a redução de custos, e compromisso com o MEIO AMBIENTE."
        
      End With

    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Assinatura Porto", objSelection
    objSignatureObject.NewMessageSignature = "Assinatura Porto"
    objSignatureObject.ReplyMessageSignature = "Assinatura Porto"
    objDoc.Saved = True
    objword.Quit       


    sexta-feira, 10 de fevereiro de 2012 16:28
  • sexta-feira, 9 de março de 2012 11:42
    Moderador