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
