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
Assinatura de e-mail via script vbs - Fonte Verdana não é aplicada
