Remove From My Forums

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

Pergunta

Entrar para Votar

Bom 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.

Editado Jefferson Microni quinta-feira, 27 de abril de 2017 12:01 ajuste título

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

Todas as Respostas

Entrar para Votar

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)

Editado Renan Antonio Rodrigues quinta-feira, 27 de abril de 2017 14:08

quinta-feira, 27 de abril de 2017 14:07

0

Entrar para Votar

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

Responder

|

Citação
0

Entrar para Votar
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)
- Editado Renan Antonio Rodrigues sexta-feira, 28 de abril de 2017 13:56
sexta-feira, 28 de abril de 2017 13:55

Responder

|

Citação
0

Entrar para Votar

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

Responder

|

Citação
0

Entrar para Votar

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

Responder

|

Citação
0

Entrar para Votar

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

Responder

|

Citação

Entrar para Votar

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)

Editado Renan Antonio Rodrigues quarta-feira, 3 de maio de 2017 23:54

quarta-feira, 3 de maio de 2017 23:53

0

Entrar para Votar

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

Responder

|

Citação
0

Entrar para Votar

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

Responder

|

Citação

Produtos

Resources

Solutions

Atualizações

Avaliações

Sites relacionados

Treinamento

Certificações

Outros recursos

Por produtos

Outros links

Não é um IT Pro?

Inquiridor

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

Pergunta

Todas as Respostas