none
Assinatura de e-mail via script vbs - Fonte Verdana não é aplicada RRS feed

  • Pergunta

  • Pessoal,

    Estou automatizando a assinatura da empresa em que trabalho, a assinatura já está configurada perfeitamente, o problema é que utilizamos a fonte Verdana 11 e esta não é aplicada na assinatura, ao invés da Verdana é aplicada a Calibre 11.

    Lembrando que a fonte Verdana é padrão do S.O. Windows.


    Segue script abaixo:

    ====================================

    On Error Resume Next
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    
    With objUser
      
    	strName = .FullName
    	strTitle = .Title
    	strl = .l
    	strco = .co
    	strMobile = .Mobile
    	strPhone = .TelephoneNumber
    	strFax = objUser.facsimileTelephoneNumber
    	strMail = .mail
    	strWeb = .wWWHomePage
    
    End With
    
    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
    
      .ParagraphFormat.Alignment = wdAlignParagraphRight
      .TypeParagraph
    
    	With .Font
    		.Name = "Verdana"
    		.Size = 11
    		.Bold = False
    		.Color = RGB(0, 117, 119)
    	End With
    	.TypeText "Atenciosamente, " & Chr(11) & Chr(11)
        .TypeText strName & Chr(11)
    	With .Font
    		.Name = "Verdana"
    		.Size = 11
    		.Bold = False
    		.Color = RGB(0, 117, 119)
    	End With
        .TypeText strTitle & Chr(11)
        Rem .TypeText strl & Chr(11)
    
    	With .Font    
    		.Size = "11" 
    		.Name = "Verdana"    
    		.Bold = True  
    		.Color = RGB(0, 117, 119)
    	End With
    
    	With .Font 
    		.Bold = false
    	End With
    
    	With .Font
    		.Name = "Verdana"
    		.Size = 11
    		.Bold = false
    		.Color = RGB(0, 117, 119)
    	End With
        .Font.Italic = False
        .TypeText "Tel.: +55" & strPhone & Chr(11)
        if len(strMobile) > 1 then
    		.TypeText "Cel.: +55" & strMobile & Chr(11)
        end if 
    	.TypeText "Rota.: " & strFax & Chr(11)
        .TypeText "Email: " & strMail & Chr(11) & "www.site.com.br" & Chr(11)
        .TypeText Chr(11)
        .InlineShapes.AddPicture "\\servidor\Wallpaper\assinatura0.png", True, True
    
        .TypeText Chr(11)
        .TypeText Chr(11)
    
    	With .Font
    		.Name = "Verdana"   
    		.TypeName = "Verdana"
    		.Size = "7"
    		.italic = true
    		.Color = 0
    		.Bold = False 
    	End With 
        
    	.TypeText "Esta mensagem pode conter informação confidencial e/ou privilegiada. Se você não for o destinatário ou a pessoa autorizada a receber esta mensagem, não pode usar, copiar ou divulgar as informações nela contidas ou tomar qualquer ação baseada nessas informações. Se você recebeu esta mensagem por engano, por favor, avise imediatamente o remetente, respondendo o e-mail, e em seguida apague-o. Agradecemos sua cooperação."
    
        .TypeText Chr(11)
        .TypeText Chr(11)
    
    	With .Font
    		.Name = "Verdana"    
    		.Size = "7"
    		.italic = true
    		.Color = 0
    		.Bold = False  
    	End With
    
    	.TypeText "This message may contain confidential and/or privileged information. If you are not the address or authorized to receive this for the address, you must not use, copy, disclose or take any action base on this message or any information herein. If you have received this message in error, please advise the sender immediately by reply e-mail and delete this message. Thank you for your cooperation"
    
    End With
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "AD Signature", objSelection
    objSignatureObject.NewMessageSignature = "AD Signature"
    objSignatureObject.ReplyMessageSignature = "AD Signature"
    objDoc.Saved = True
    objword.Quit 

    ============================================

    Agradeço antecipadamente a ajuda!!!


    Alan Barros


    terça-feira, 11 de novembro de 2014 13:11

Respostas

  • Fábio, sem problema e obrigado pela força!!!

    Olha só, um dos amigos aqui da empresa deu uma olhada no script e viu que existia alguns parâmetros que chamavam a fonte Verdana e que o Outlook simplesmente se perdia, e com isso deixava a fonte Calibre que padrão do Outlook. 

    Segue abaixo o novo script que estamos usando, e que funciona 100% 

    #############################################################

    On Error Resume Next
    
    ' Define o espaçamento quando ocorre uma quebra de linha como simples.
    Const WdLineBreak = 1
    
    ' Cria um link com o AD para obter as informações atuais do funcionário.
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    
    ' Defina aqui o nome da assinatura.
    strAssinatura = "Padrão"
    
    ' Atribui as informações do AD às variáveis.
    strNomeCompleto = objUser.FullName
    strDepartamento = objUser.department
    strFuncao = objUser.Title
    strTelefone = objUser.telephoneNumber
    
    strRota = objUser.facsimileTelephoneNumber ' O campo de fax do AD está sendo usado para definir a rota.
    strCelular = objUser.mobile
    strNextel = objUser.pager ' O campo de pager do AD está sendo usado para definir o Nextel.
    strEmail = objUser.mail
    strWWW = "www.site.com.br"
    
    ' INÍCIO do bloco para impedir a troca da assinatura padrão.
    ' Aplicado para as seguintes versões do Office: 2013 (11), 2007 (12), 2010 (14) e 2013 (15).
    Set objShell = CreateObject("WScript.Shell")
    
    ' Apaga a pasta "Assinaturas".
    'Set fso = CreateObject("Scripting.FileSystemObject")
    'APPDATA = ObjShell.ExpandEnvironmentStrings("%appdata%")
    'PastaAssinaturas = APPDATA & "\Microsoft\Assinaturas"
    'fso.DeleteFolder PastaAssinaturas
    
    ' Apaga somente a pasta e arquivos da assinatura "padrao"
    'Set fso = CreateObject("Scripting.FileSystemObject")
    'APPDATA = ObjShell.ExpandEnvironmentStrings("%appdata%")
    'PastaAssinatura = APPDATA & "\Microsoft\Assinaturas\padrao_arquivos"
    'ArquivoAssinaturaHTM = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.htm"
    'ArquivoAssinaturaRTF = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.rtf"
    'ArquivoAssinaturaTXT = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.txt"
    
    'if fso.FileExists(ArquivoAssinaturaHTM) then
    'fso.DeleteFolder PastaAssinatura
    'fso.DeleteFile ArquivoAssinaturaHTM
    'fso.DeleteFile ArquivoAssinaturaRTF
    'fso.DeleteFile ArquivoAssinaturaTXT
    'end if
    
    'RegKey2003 = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
    'RegKey2007 = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\General"
    'RegKey2010 = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\General"
    'RegKey2013 = "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\General"
    
    'RegKey2003 = RegKey2003 & "\Signatures"
    'RegKey2007 = RegKey2007 & "\Signatures"
    'RegKey2010 = RegKey2010 & "\Signatures"
    'RegKey2013 = RegKey2013 & "\Signatures"
    
    'objShell.RegWrite RegKey2003 , "Assinaturas"
    'objShell.RegWrite RegKey2007 , "Assinaturas"
    'objShell.RegWrite RegKey2010 , "Assinaturas"
    'objShell.RegWrite RegKey2013 , "Assinaturas"
    
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    ' FIM do bloco para impedir a troca da assinatura padrão.
    
    ' Cria um objeto do tipo Word, mas não exibe a abertura dele na sessão do desktop.
    Set objWord = CreateObject("Word.Application")
    
    ' Cria o novo documento do tipo Word.
    Set objDoc = objWord.Documents.Add()
    Set objSelection = objWord.Selection
    Set objEmailOptions = objWord.EmailOptions
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    ' Don't use extra spaces at all
    objSelection.ParagraphFormat.SpaceAfter = 0
    
    ' Definição da cor e tamanho da fonte da assinatura.
    ' O tipo da fonte está definido no fim do documento.
    objSelection.Font.Color = RGB("0", "117", "140")
    objSelection.Font.Size = "11"
    
    objSelection.TypeText "Atenciosamente,"
    objSelection.InsertBreak WdLineBreak
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strNomeCompleto
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strDepartamento
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strFuncao
    objSelection.InsertBreak WdLineBreak
    
    ' Valida e exibe se o funcionário possui telefone.
    if len(strTelefone) > 0 then
    	objSelection.TypeText "Tel.: +55 " & strTelefone
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Valida e exibe se o funcionário possui rota.
    if len(strRota) > 0 then
    	objSelection.TypeText "Rota: " & strRota
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Valida e exibe se o funcionário possui celular.
    if len(strCelular) > 0 then
    	objSelection.TypeText "Cel.: +55 " & strCelular
    	objSelection.InsertBreak WdLineBreak
    end if
    
    
    
    ' Valida e exibe se o funcionário possui Nextel.
    if len(strNextel) > 0 then
    	objSelection.TypeText "Nextel.: +55 " & strNextel
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Exibe o e-mail do funcionário.
    objSelection.TypeText "E-mail: " & strEmail
    objSelection.InsertBreak WdLineBreak 
    
    ' Adiciona o hyperlink do site e a imagem da SITE.
    objSelection.Hyperlinks.Add objSelection.Range, "" & strWWW & "", , , "www.site.com.br"
    objSelection.InsertBreak WdLineBreak 
    objSelection.InlineShapes.AddPicture "\\servidor\papeldeparede\assinatura.png", True, True
    objSelection.InsertBreak WdLineBreak 
    objSelection.TypeText "_______________________________________________________________________________________________________________________________________________________"
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    
    ' Definição da cor e tamanho da fonte do texto informativo.
    objSelection.Font.Color = RGB("169", "169", "169")
    objSelection.Font.Size = "7"
    
    ' Texto informativo em três idiomas.
    objSelection.TypeText "O emitente desta mensagem é responsável por seu conteúdo e endereçamento.  Sem a devida autorização, a divulgação, a reprodução, a distribuição ou qualquer outra ação em desconformidade com as normas internas da empresa são proibidas e passíveis de sanção disciplinar, civil e criminal."
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText "The sender of this message is responsible for its content and addressing. Any publication, reproduction, distribution or action out of conformity with internal policies of .... are strictly forbidden and liable to disciplinary, civil or criminal sanctions." 
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText "El emisor de este mensaje es responsable por su contenido y direccionamiento. Cabe al destinatario darle el tratamiento adecuado. Sin la debida autorización, su divulgación, reproducción, distribución o cualquier otra acción no conforme a las normas internas del ......l están prohibidas y serán pasibles de sanción disciplinaria, civil y penal." 
    
    ' Encerra o objeto.
    Set objSelection = objDoc.Range()
    
    ' Define a fonte padrão do documento.
    objSelection.Font.Name = "Verdana"
    
    ' Cria a assinatura "padrao" e define o uso dela para novas mensagens e para respostas.
    objSignatureEntries.Add strAssinatura, objSelection
    objSignatureObject.NewMessageSignature = strAssinatura
    objSignatureObject.ReplyMessageSignature = strAssinatura
    
    ' Salva e encerra o documento.
    objDoc.Saved = True
    objWord.Quit 


    quarta-feira, 26 de novembro de 2014 17:08

Todas as Respostas

  • Tire o "on error resume next" e execute pra ver se vai indicar algum erro.

    Fábio de Paula Junior

    terça-feira, 11 de novembro de 2014 17:27
    Moderador
  • Fábio,

    Fiz o teste, dá um erro na linha 85. Removi a linha. Rodei o script local na estação e mesmo assim a fonte que é carregada é a Calibre.

    With .Font
     .Name = "Verdana"   
     .TypeName = "Verdana"  (LINHA 85)
     .Size = "7"
     .italic = true
     .Color = 0
     .Bold = False 


    Valeu a força!

    terça-feira, 11 de novembro de 2014 17:41
  • Manda um print do erro.

    Fábio de Paula Junior

    terça-feira, 11 de novembro de 2014 17:54
    Moderador
  • Segue erro após remover o "on error resume next": 
    terça-feira, 11 de novembro de 2014 17:58
  • Alguém poderia ajudar??????
    quinta-feira, 13 de novembro de 2014 11:19
  • A principio não parece ser problema no Script.

    Veja, rodei na minha máquina e as fontes apareceram como Verdana.


    Fábio de Paula Junior

    quinta-feira, 13 de novembro de 2014 12:55
    Moderador
  • Só um chute,

    Rode este script (PowerShell) pra ver a lista de fontes instaladas no seu computador.

    Veja se aparece Verdana.

    [void] [System.Reflection.Assembly]::LoadWithPartialName("System.Drawing")
    
    $objFonts = New-Object System.Drawing.Text.InstalledFontCollection
    $objFonts.Families

    Ref.:

    Listing the TrueType Fonts Installed On Your Computer

    http://technet.microsoft.com/en-us/library/ff730944.aspx




    Fábio de Paula Junior


    quinta-feira, 13 de novembro de 2014 13:26
    Moderador
  • Todas as estações do parque já possuem a fonte instalada. Deixa eu passar uma informações que talvez facilite na resolução.

    Estou testando em uma estação com o S.O. windows 8.1 e Office 2013, Nesta estação a fonte verdana aparece normalmente, já as outras estações são todas Windows 7 e office 2013 e nestas a fonte aparece calibre.

    Testei com diversas outras fontes e funciona bem nas duas versões do S.O. (7 e 8.1).


    Abraço.

    quinta-feira, 13 de novembro de 2014 14:18
  • Rode o script powershell no 8.1 e no 7 e compare a saída.

    O teste que eu fiz foi em um Windows 7.


    Fábio de Paula Junior

    quinta-feira, 13 de novembro de 2014 15:09
    Moderador
  • Fábio, rodei o script nas duas versões do windows, e a fonte verdana está presente em ambas saídas. Segue print:

    quinta-feira, 13 de novembro de 2014 17:59
  • Alguém poderia ajudar????
    segunda-feira, 17 de novembro de 2014 13:03
  • Desculpe não conseguir ajudar mais, me parece que não é um problema no script (tanto que aqui pra mim ele funcionou).

    Talvez seja algo no seu ambiente, e não tenho algo parecido com o seu então fica dificil pra ajudar.


    Fábio de Paula Junior

    sexta-feira, 21 de novembro de 2014 15:40
    Moderador
  • Fábio, sem problema e obrigado pela força!!!

    Olha só, um dos amigos aqui da empresa deu uma olhada no script e viu que existia alguns parâmetros que chamavam a fonte Verdana e que o Outlook simplesmente se perdia, e com isso deixava a fonte Calibre que padrão do Outlook. 

    Segue abaixo o novo script que estamos usando, e que funciona 100% 

    #############################################################

    On Error Resume Next
    
    ' Define o espaçamento quando ocorre uma quebra de linha como simples.
    Const WdLineBreak = 1
    
    ' Cria um link com o AD para obter as informações atuais do funcionário.
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    
    ' Defina aqui o nome da assinatura.
    strAssinatura = "Padrão"
    
    ' Atribui as informações do AD às variáveis.
    strNomeCompleto = objUser.FullName
    strDepartamento = objUser.department
    strFuncao = objUser.Title
    strTelefone = objUser.telephoneNumber
    
    strRota = objUser.facsimileTelephoneNumber ' O campo de fax do AD está sendo usado para definir a rota.
    strCelular = objUser.mobile
    strNextel = objUser.pager ' O campo de pager do AD está sendo usado para definir o Nextel.
    strEmail = objUser.mail
    strWWW = "www.site.com.br"
    
    ' INÍCIO do bloco para impedir a troca da assinatura padrão.
    ' Aplicado para as seguintes versões do Office: 2013 (11), 2007 (12), 2010 (14) e 2013 (15).
    Set objShell = CreateObject("WScript.Shell")
    
    ' Apaga a pasta "Assinaturas".
    'Set fso = CreateObject("Scripting.FileSystemObject")
    'APPDATA = ObjShell.ExpandEnvironmentStrings("%appdata%")
    'PastaAssinaturas = APPDATA & "\Microsoft\Assinaturas"
    'fso.DeleteFolder PastaAssinaturas
    
    ' Apaga somente a pasta e arquivos da assinatura "padrao"
    'Set fso = CreateObject("Scripting.FileSystemObject")
    'APPDATA = ObjShell.ExpandEnvironmentStrings("%appdata%")
    'PastaAssinatura = APPDATA & "\Microsoft\Assinaturas\padrao_arquivos"
    'ArquivoAssinaturaHTM = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.htm"
    'ArquivoAssinaturaRTF = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.rtf"
    'ArquivoAssinaturaTXT = "C:\Users\egomes\AppData\Roaming\Microsoft\Assinaturas\padrao.txt"
    
    'if fso.FileExists(ArquivoAssinaturaHTM) then
    'fso.DeleteFolder PastaAssinatura
    'fso.DeleteFile ArquivoAssinaturaHTM
    'fso.DeleteFile ArquivoAssinaturaRTF
    'fso.DeleteFile ArquivoAssinaturaTXT
    'end if
    
    'RegKey2003 = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
    'RegKey2007 = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\General"
    'RegKey2010 = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\General"
    'RegKey2013 = "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\General"
    
    'RegKey2003 = RegKey2003 & "\Signatures"
    'RegKey2007 = RegKey2007 & "\Signatures"
    'RegKey2010 = RegKey2010 & "\Signatures"
    'RegKey2013 = RegKey2013 & "\Signatures"
    
    'objShell.RegWrite RegKey2003 , "Assinaturas"
    'objShell.RegWrite RegKey2007 , "Assinaturas"
    'objShell.RegWrite RegKey2010 , "Assinaturas"
    'objShell.RegWrite RegKey2013 , "Assinaturas"
    
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\NewSignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Common\MailSettings\ReplySignature" , strAssinatura
    'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
    ' FIM do bloco para impedir a troca da assinatura padrão.
    
    ' Cria um objeto do tipo Word, mas não exibe a abertura dele na sessão do desktop.
    Set objWord = CreateObject("Word.Application")
    
    ' Cria o novo documento do tipo Word.
    Set objDoc = objWord.Documents.Add()
    Set objSelection = objWord.Selection
    Set objEmailOptions = objWord.EmailOptions
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    ' Don't use extra spaces at all
    objSelection.ParagraphFormat.SpaceAfter = 0
    
    ' Definição da cor e tamanho da fonte da assinatura.
    ' O tipo da fonte está definido no fim do documento.
    objSelection.Font.Color = RGB("0", "117", "140")
    objSelection.Font.Size = "11"
    
    objSelection.TypeText "Atenciosamente,"
    objSelection.InsertBreak WdLineBreak
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strNomeCompleto
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strDepartamento
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText strFuncao
    objSelection.InsertBreak WdLineBreak
    
    ' Valida e exibe se o funcionário possui telefone.
    if len(strTelefone) > 0 then
    	objSelection.TypeText "Tel.: +55 " & strTelefone
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Valida e exibe se o funcionário possui rota.
    if len(strRota) > 0 then
    	objSelection.TypeText "Rota: " & strRota
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Valida e exibe se o funcionário possui celular.
    if len(strCelular) > 0 then
    	objSelection.TypeText "Cel.: +55 " & strCelular
    	objSelection.InsertBreak WdLineBreak
    end if
    
    
    
    ' Valida e exibe se o funcionário possui Nextel.
    if len(strNextel) > 0 then
    	objSelection.TypeText "Nextel.: +55 " & strNextel
    	objSelection.InsertBreak WdLineBreak
    end if
    
    ' Exibe o e-mail do funcionário.
    objSelection.TypeText "E-mail: " & strEmail
    objSelection.InsertBreak WdLineBreak 
    
    ' Adiciona o hyperlink do site e a imagem da SITE.
    objSelection.Hyperlinks.Add objSelection.Range, "" & strWWW & "", , , "www.site.com.br"
    objSelection.InsertBreak WdLineBreak 
    objSelection.InlineShapes.AddPicture "\\servidor\papeldeparede\assinatura.png", True, True
    objSelection.InsertBreak WdLineBreak 
    objSelection.TypeText "_______________________________________________________________________________________________________________________________________________________"
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    
    ' Definição da cor e tamanho da fonte do texto informativo.
    objSelection.Font.Color = RGB("169", "169", "169")
    objSelection.Font.Size = "7"
    
    ' Texto informativo em três idiomas.
    objSelection.TypeText "O emitente desta mensagem é responsável por seu conteúdo e endereçamento.  Sem a devida autorização, a divulgação, a reprodução, a distribuição ou qualquer outra ação em desconformidade com as normas internas da empresa são proibidas e passíveis de sanção disciplinar, civil e criminal."
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText "The sender of this message is responsible for its content and addressing. Any publication, reproduction, distribution or action out of conformity with internal policies of .... are strictly forbidden and liable to disciplinary, civil or criminal sanctions." 
    objSelection.InsertBreak WdLineBreak 
    objSelection.InsertBreak WdLineBreak
    objSelection.TypeText "El emisor de este mensaje es responsable por su contenido y direccionamiento. Cabe al destinatario darle el tratamiento adecuado. Sin la debida autorización, su divulgación, reproducción, distribución o cualquier otra acción no conforme a las normas internas del ......l están prohibidas y serán pasibles de sanción disciplinaria, civil y penal." 
    
    ' Encerra o objeto.
    Set objSelection = objDoc.Range()
    
    ' Define a fonte padrão do documento.
    objSelection.Font.Name = "Verdana"
    
    ' Cria a assinatura "padrao" e define o uso dela para novas mensagens e para respostas.
    objSignatureEntries.Add strAssinatura, objSelection
    objSignatureObject.NewMessageSignature = strAssinatura
    objSignatureObject.ReplyMessageSignature = strAssinatura
    
    ' Salva e encerra o documento.
    objDoc.Saved = True
    objWord.Quit 


    quarta-feira, 26 de novembro de 2014 17:08