none
Script VBS para inserir Assinatura Outlook - problema com alinhamento de imagens RRS feed

  • Pergunta

  • QuestionBom dia,

    Preciso de ajuda para alinhamento da imagem/texto da assinatura.

    A configurei baseado nesta thread e em outras similares (tentei por tabela mas não deu certo).

    Não consigo alinhas as duas imagens (a linha horizontal e a logo) e os dados extraidos do AD a direita. A 2ª imagem (logo) inserida não obedece aos códigos de formatação, somente a 1ª imagem inserida (linha) que consigo configurar corretamente as opções de layout (quadrado, acima/abaixo, justa, etc.).

    A assinatura está ficando assim:

    Com este trecho de código:

    'mais código acima...
    
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    With objSelection
    
    .ParagraphFormat.Alignment = wdAlignParagraphRight
    .TypeParagraph
    
    .InlineShapes.AddPicture "\\10.1.0.2\netlogon\scripts\linha2.png", True, True
    objDoc.InlineShapes(1).ConvertToShape
    objDoc.Shapes(1).WrapFormat.Type = 4 'WdWrapTopBottom '4 Coloca o texto acima e abaixo da forma.
    
    .InlineShapes.AddPicture "\\10.1.0.2\netlogon\scripts\rodape-alt8.png", True, True
    objDoc.InlineShapes(2).ConvertToShape
    objDoc.Shapes(2).WrapFormat.DistanceTop = InchesToPoints(0.5)
    objDoc.Shapes(2).WrapFormat.Type = wdWrapSquare ' Envolve o texto em torno da forma. A continuação da linha está no lado oposto da forma.
    
    'Deste ponto abaixo monto a assinatura com dados do AD
    
    REM NOME DO DO USUARIO
    With .Font
    .Name = "Arial"
    .Size = 10
    .Bold = true
    .Color = RGB(0,0,0)
    End With
    strNameComp = Split(strName, ", ")
    strNameP = strNameComp(1)
    strNameS = strNameComp(0)
    .TypeText Chr(11) & strNameP & "" & strNameS & Chr(11)
    
    'mais código abaixo...

    Precisava que ela ficasse configurada/alinhada assim:

    Agradeço a atenção e ajuda.

    att.

    Jefferson.


    quinta-feira, 27 de abril de 2017 11:40

Todas as Respostas

  • Jefferson tudo bem?

    Amigo, encaminho abaixo um script que criei há alguns anos para a mesma finalidade, e o mesmo possui o formato que deseja, a imagem ao lado, e as demais informações a direita.

    Não consegui validar aqui da minha máquina, então encaminho para que possa lhe dar uma direção, fazendo os ajustes que se fizerem necessários aos seu cenário.

    On Error Resume Next
    Const end_table = 6
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    strnome = objUser.FullName
    strsetor = objUser.Department
    strtel = objUser.TelephoneNumber
    stremail = objUser.mail
    strweb = objUser.wWWHomePage 'página web buscando do AD
    strfacebook = "http://www.facebook.com/empresa"
    strtwitter = "http://twitter.com/#!/empresa"
    
    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,6,2
      Set objTable = objDoc.Tables(1)
    End With
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    With objSelection
    objTable.Columns.Width =  400
    objTable.Cell(1, 1).Merge objTable.Cell(6, 1)
    
    
    'insira abaixo o link do seu logo
    objTable.Cell(1, 1).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("http://www.link.com.br/assinatura/LOGO_empresa.png"), strweb)
    
    objTable.Cell(1, 2).Range.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(1, 2).Range.Font.Bold = True
        objTable.Cell(1, 2).Range.Font.Size = "9"
        objTable.Cell(1, 2).Range.Font.Name = "Arial"
    objTable.Cell(1, 2).Range.Font.Color = RGB(0, 0, 0)
    objTable.Columns(1).Width = objWord.InchesToPoints(1)
    objTable.Cell(1, 2).Range.Text = strnome 
    
    objTable.Cell(2, 2).Range.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(2, 2).Range.Font.Bold = True
    objTable.Cell(2, 2).Range.Font.Size = "9"
        objTable.Cell(2, 2).Range.Font.Name = "Arial"
    objTable.Cell(2, 2).Range.Font.Color = RGB(110, 180, 63)
    objTable.Columns(1).Width = objWord.InchesToPoints(1)
    
    objTable.Cell(2, 2).Range.Text = strsetor
    
    objTable.Cell(3, 2).Range.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(3, 2).Range.Font.Size = "9"
        objTable.Cell(3, 2).Range.Font.Name = "Arial"
    objTable.Cell(3, 2).Range.Font.Color = RGB(0, 0, 0)
    objTable.Columns(1).Width = objWord.InchesToPoints(1)
    objTable.Cell(3, 2).Range.Text = strtel
    
    objTable.Cell(4, 2).Range.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(4, 2).Range.Font.Size = "9"
        objTable.Cell(4, 2).Range.Font.Name = "Arial"
    objTable.Cell(4, 2).Range.Font.Color = RGB(0, 0, 0)
    objTable.Columns(1).Width = objWord.InchesToPoints(1)
    objTable.Cell(4, 2).Range.Text = stremail
    
    objTable.Cell(5, 2).Range.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(5, 2).Range.Font.Bold = True
    objTable.Cell(5, 2).Range.Font.Size = "9"
    objTable.Cell(5, 2).Range.Font.Name = "Arial"
    objTable.Cell(5, 2).Range.Font.Color = RGB(110, 180, 63)
    objTable.Columns(1).Width = objWord.InchesToPoints(1)
    objTable.Cell(5, 2).Range.Text = strweb
    
    objTable.Cell(6, 2).Range.Select.ParagraphFormat.SpaceAfter = 0
    objTable.Cell(6, 2).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("http://www.link.com.br/assinatura/twitter-icon.png"), strtwitter)
    objTable.Cell(6, 2).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("http://www.link.com.br/assinatura/facebook-icon.png"), strfacebook)
    
    .TypeText Chr(1)
    
    .EndKey end_table
    
    End With
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Assinatura Padrão", objSelection
    objSignatureObject.NewMessageSignature = "Assinatura Padrão"
    objSignatureObject.ReplyMessageSignature = "Assinatura Padrão"
    objDoc.Saved = True
    objword.Quit


    Se ajudar marque como útil.

    Att, Renan


    Renan A. Rodrigues MCSA-MCITP-MCTS-CCNA-CCENT-ITIL (renanrodrigues.com)


    quinta-feira, 27 de abril de 2017 14:07
  • Bom dia Renan,

    está dando erro no script e não carrega.

    Eu já havia testado um outro modelo anteriormente com tabela mas ficava dando erro e não consegui fazer funcionar. Se puder me ajudar...

    Obrigado.

    att.

    Jefferson

    sexta-feira, 28 de abril de 2017 12:59
  • Jefferson,

    Consegui validar no meu computador pessoal, e não ocorreu erros. Acredito que no seu caso o erro é o link da imagem. Somente para testes, coloque sua imagem no disco local da sua máquina e ajuste no script para algo como "C:\imagem.png". Faça o mesmo para todos os links do script que estiver buscando da rede.

    Outro detalhe, execute primeiro direto na sua máquina com duplo clique no script, depois que estiver ok localmente, valide pelo scriptlogon.

    A estrutura do script esta correta, deve ser algum detalhe como este...

    Estou a disposição.

    Grato.

    Att, Renan


    Renan A. Rodrigues MCSA-MCITP-MCTS-CCNA-CCENT-ITIL (renanrodrigues.com)


    sexta-feira, 28 de abril de 2017 13:55
  • Boa tarde Renan,

    obrigado pela atenção e disponibilidade em ajudar.

    fiz a simulação como orientou, script, imagens em pasta local no C:\ e executando-o por clique duplo. O erro permanece o mesmo. Quando rodo outro script sem tabela não da o erro, que seria aquele que postei originalmente que não consigo alinhar as imagens (sem tabela).

    Então concluo que na minha máquina não esta aceitando, interpretando esta notação de declaração/utilização de tabelas. O erro é acusado na linha 33,1 na primeira chamada ao objTable, como se o script não reconhece-se a existencia/declaração da mesma.

    Obrigado Renan.

    Att.

    Jefferson.

    sexta-feira, 28 de abril de 2017 17:00
  • Jefferson,

    Qual versão do Office e Windows que você tem em sua máquina?

    Faça as seguintes ações para descobrirmos onde esta o erro:

    Execute o script em outra máquina localmente, de preferencia com Office 2010.

    Se não der certo, desative o controle de usuário do sistema.

    Por último veja se seu antivirus esta bloqueando a execução do script.

    Revisei o script, fiz mais testes em minha máquina, que é o Windows 10 Pro e Office 2010, e esta tudo correto.

    Se não der resultado acima, comente a parte do script, On Error Resume Next e comente o resultado.

    Obrigado.

    Att, Renan 

     


    Renan A. Rodrigues MCSA-MCITP-MCTS-CCNA-CCENT-ITIL (renanrodrigues.com)

    sexta-feira, 28 de abril de 2017 21:19
  • Boa tarde Renan,

    - A minha máquina que uso para desenvolver e testar os scripts:

    Windows 7 PRO 64 bits - Microsoft Office Professional Plus 2016 64 bits

    - Fiz o teste em outro computador como indicado:

    * Windows 7 PRO 32 bits - Microsoft Office Home and Business 2010 32 bits

    * Desativei a UAC

    * Desinstalei o antívirus (ja estava fazendo isso para outro teste)

    * On Error Resume Next comentado

    * Permaneceu o erro, na mesma linha do erro do meu PC, na chamada do objTable, segue o print:

    Espero que posso ter solução.

    Obrigado pela atenção e disponibilidade.

    Att.

    Jefferson.

    quarta-feira, 3 de maio de 2017 16:36
  • On Error Resume Next
    Const end_table = 6
    'Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = "teste"'objSysInfo.UserName
    Set objUser = "teste1"'GetObject("LDAP://" & strUser)
    strnome = "teste2"'objUser.FullName
    strsetor = "teste3"'objUser.Department
    strtel = "teste4"'objUser.TelephoneNumber
    stremail = "teste5"'objUser.mail
    strweb = "teste6"'objUser.wWWHomePage
    
    
    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,6,2
      Set objTable = objDoc.Tables(1)
    End With
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    With objSelection
    	objTable.Columns.Width =  400
    	objTable.Cell(1, 1).Merge objTable.Cell(6, 1)	
    	
    	'objTable.Cell(1, 1).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("C:\assinatura-teste\rodape-alt8.png"), strweb)
    	'objTable.Cell(1, 1).Range.Select.Text = objSelection.InlineShapes.AddPicture("C:\assinatura-teste\rodape-alt8.png")	
    	objSelection.InlineShapes.AddPicture("C:\assinatura-teste\rodape-alt8.png")	
    	
    	objTable.Cell(1, 2).Range.ParagraphFormat.SpaceAfter = 0
    	objTable.Cell(1, 2).Range.Font.Bold = True
        objTable.Cell(1, 2).Range.Font.Size = "9"
        objTable.Cell(1, 2).Range.Font.Name = "Arial"
    	objTable.Cell(1, 2).Range.Font.Color = RGB(0, 0, 0)
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)
    	objTable.Cell(1, 2).Range.Text = strnome 
    	
    	objTable.Cell(2, 2).Range.ParagraphFormat.SpaceAfter = 0
    	objTable.Cell(2, 2).Range.Font.Bold = True
    	objTable.Cell(2, 2).Range.Font.Size = "9"
        objTable.Cell(2, 2).Range.Font.Name = "Arial"
    	objTable.Cell(2, 2).Range.Font.Color = RGB(110, 180, 63)
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)	
    	objTable.Cell(2, 2).Range.Text = strsetor
    	
    	objTable.Cell(3, 2).Range.ParagraphFormat.SpaceAfter = 0
    	objTable.Cell(3, 2).Range.Font.Size = "9"
        objTable.Cell(3, 2).Range.Font.Name = "Arial"
    	objTable.Cell(3, 2).Range.Font.Color = RGB(0, 0, 0)
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)
    	objTable.Cell(3, 2).Range.Text = strtel
    
    	objTable.Cell(4, 2).Range.ParagraphFormat.SpaceAfter = 0
    	objTable.Cell(4, 2).Range.Font.Size = "9"
        objTable.Cell(4, 2).Range.Font.Name = "Arial"
    	objTable.Cell(4, 2).Range.Font.Color = RGB(0, 0, 0)
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)
    	objTable.Cell(4, 2).Range.Text = stremail
    
    	objTable.Cell(5, 2).Range.ParagraphFormat.SpaceAfter = 0
    	objTable.Cell(5, 2).Range.Font.Bold = True
    	objTable.Cell(5, 2).Range.Font.Size = "9"
    	objTable.Cell(5, 2).Range.Font.Name = "Arial"
    	objTable.Cell(5, 2).Range.Font.Color = RGB(110, 180, 63)
    	objTable.Columns(1).Width = objWord.InchesToPoints(1)
    	objTable.Cell(5, 2).Range.Text = strweb
    	
    	'objTable.Cell(6, 2).Range.Select.ParagraphFormat.SpaceAfter = 0
    	'objTable.Cell(6, 2).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("F:\04.png"), strtwitter)
    	'objTable.Cell(6, 2).Range.Select.Text = objDoc.Hyperlinks.Add (objSelection.InlineShapes.AddPicture("F:\04.png"), strfacebook)
    	
    	.TypeText Chr(1)
    	
    	.EndKey end_table
    
    
    End With
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Assinatura Padrão", objSelection
    objSignatureObject.NewMessageSignature = "Assinatura Padrão"
    objSignatureObject.ReplyMessageSignature = "Assinatura Padrão"
    objDoc.Saved = True
    objword.Quit

    Jefferson, boa noite.

    Copie e cole o script modificado acima, salve como vbs, e execute na sua máquina como administrador localmente, veja se funcionará.

    obrigado.

    Att, Renan


    Renan A. Rodrigues MCSA-MCITP-MCTS-CCNA-CCENT-ITIL (renanrodrigues.com)


    quarta-feira, 3 de maio de 2017 23:53
  • Bom dia Renan,

    No meu PC:

    No outro PC de teste:

    Obrigado pelo empenho.

    att.

    Jefferson.

    quinta-feira, 4 de maio de 2017 11:57
  • Jefferson,

    Desculpe pela demora em responder.

    De fato não sei o que pode estar ocorrendo em seu ambiente, já que testei em dois ambientes distintos e funcionou. Sugiro fazer testes em outro ambiente, ou então talvez buscar outras alternativas. É uma pena pois o fonte enviado iria funcionar exatamente como você queria.

    De qualquer forma fico a disposição para ajudar no que for preciso.

    Grato.

    Att, Renan


    Renan A. Rodrigues MCSA-MCITP-MCTS-CCNA-CCENT-ITIL (renanrodrigues.com)

    quinta-feira, 11 de maio de 2017 21:48