none
Assinatura vbs para Html RRS feed

  • Pergunta

  •  E ae pessoal blz?

    Seguinte, eu ja vi que tem varios topicos perguntando sobre assinatura, mas eu tenho outra duvida. No caso eu tenho a assinatura pronta mais preciso converte-la em Html. Como posso fazer isso e se eu criar a assinatura em html como posso inserir via script no Outlook.

    Desde ja agredeço.

     

     

    quinta-feira, 31 de março de 2011 17:36

Respostas

  • Alberto,

    Boa noite pelo que entendi você tem a assinatura pronta em HTML correto?

    No meu caso alguns clientes utilizam Thunderbird e outros Outlook o Outlook a assinatura é baseada em word(doc)...
    já o thunderbird é html devido a isso eu criei uma assinatura de cria no outlook e tambem cria o HTML.

    Segue anexo.

    Const END_OF_STORY = 6
    Const wdFormatHTML = 8
    
    On Error Resume Next
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    
    
    strName = "Edson Matias Fagundes Junior"
    strTitle = "IT Consulting / Networking Design"
    strCompany = objUser.Company
    strl = objUser.l
    strco = objUser.co
    strPhone = "+55 11 "
    strFax = "emfagundesjr"
    strMobile = "+55 11 "
    strWeb = "MCP, MCTS: 2008, MCTS:MBS"
    strUserName = objuser.sAMAccountName
    
    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,1,2
     Set objTable = objDoc.Tables(1)
    
    End With
    
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    With objSelection
    
    objTable.Rows.Add()
       
       objTable.Cell(2, 1).Range.InlineShapes.AddPicture "C:\Users\Administrator\Pictures\logo.jpg",true,True
       objTable.Columns(1).Width = objWord.InchesToPoints(1)
       
       objTable.Cell(2, 2).Select
       With .Font
      .Name = "Verdana"
      .Size = 10
      .Bold = True
      .Color = 0
       End With
      .TypeText strName & Chr(11)
      '.TypeParagraph()
    
     With .Font
      .Name = "Verdana"
      .Size = 8
      .Bold = False
      .Italic = False
      .Color = 0
     End With
      .TypeText strTitle & Chr(11) & strWeb & Chr(11) & "Tel. " & strPhone & Chr(11) & "Cel. " & strMobile & Chr(11) & "Skype/Gtalk. " & strFax & Chr(11) 
      objTable.Columns(2).Width = objWord.inchesToPoints(0) 
    
    objSelection.EndKey END_OF_STORY  
    
      objSelection.Font.Name = "Verdana"
      objSelection.Font.Size = "8"
      objSelection.Font.italic = true
      objSelection.Font.Color = Black
      objSelection.Font.Bold = False 
      objSelection.TypeText "Esta mensagem e seus anexos são confidenciais e talvez privilegiados. Se você não é o destinatário, por favor notifique o remetente imediatamente e não divulgue o conteúdo para terceiros, tampouco use para outros propósitos ou armazene tais informações."
      .TypeText Chr(11)
      .TypeText Chr(11)
      objSelection.Font.italic = true
      objSelection.Font.Color = 240240  
      objSelection.Font.Bold = False 
      objSelection.TypeText "* PENSE NA NATUREZA ANTES DE IMPRIMIR."
    
    
     End With
    
    
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Padrao Edson Fagundes", objSelection
    objSignatureObject.NewMessageSignature = "Padrao Edson Fagundes"
    objSignatureObject.ReplyMessageSignature = "Padrao Edson Fagundes"
    msgbox ("TESTE")
    'objDoc.SaveAs "C:\Users\Administrator\Pictures\Junior.htm", wdFormatHTML
    objDoc.Saved = True
    objword.Quit
    
    'Dim FileName, Find, ReplaceWith, FileContents, dFileContents
    
    'Find     = "" & strUserName &"_arquivos/image001.gif"
    'ReplaceWith = "file://///servidor/sys/assinaturas/" & strUserName & "_arquivos/image001.gif"
    'FileName   = "\\servidor\sys\assinaturas\" & strUserName & ".htm"
    
    'Read source text file
    'FileContents = GetFile(FileName)
    
    'replace all string In the source file
    'dFileContents = replace(FileContents, Find, ReplaceWith, 1, -1, 1)
    
    'Compare source And result
    'if dFileContents <> FileContents Then
     'write result If different
     ' WriteFile FileName, dFileContents
     'If Len(ReplaceWith) <> Len(Find) Then 'Can we count n of replacements?
     ' End If
    'Else
     ' Wscript.Echo "Arquivo de assinatura nao encontrado favor entrar em contato com a TI"
    'End If
    
    'Read text file
    'function GetFile(FileName)
     ' If FileName<>"" Then
     ' Dim FS, FileStream
      ' Set FS = CreateObject("Scripting.FileSystemObject")
      ' on error resume Next
       ' Set FileStream = FS.OpenTextFile(FileName)
       'GetFile = FileStream.ReadAll
     'End If
    'End Function
    
    'Write string As a text file.
    'function WriteFile(FileName, Contents)
     ' Dim OutStream, FS
    
     ' on error resume Next
    ' Set FS = CreateObject("Scripting.FileSystemObject")
     ' Set OutStream = FS.OpenTextFile(FileName, 2, True)
      ' OutStream.Write Contents
    'End Function
    



    Espero ajudar Abraços.


    Edson Matias Fagundes Junior (Nioks)
    • Marcado como Resposta alberto batista quinta-feira, 20 de outubro de 2011 17:58
    quarta-feira, 3 de agosto de 2011 02:26

Todas as Respostas

  • Alberto,

    Boa noite pelo que entendi você tem a assinatura pronta em HTML correto?

    No meu caso alguns clientes utilizam Thunderbird e outros Outlook o Outlook a assinatura é baseada em word(doc)...
    já o thunderbird é html devido a isso eu criei uma assinatura de cria no outlook e tambem cria o HTML.

    Segue anexo.

    Const END_OF_STORY = 6
    Const wdFormatHTML = 8
    
    On Error Resume Next
    Set objSysInfo = CreateObject("ADSystemInfo")
    strUser = objSysInfo.UserName
    Set objUser = GetObject("LDAP://" & strUser)
    
    
    strName = "Edson Matias Fagundes Junior"
    strTitle = "IT Consulting / Networking Design"
    strCompany = objUser.Company
    strl = objUser.l
    strco = objUser.co
    strPhone = "+55 11 "
    strFax = "emfagundesjr"
    strMobile = "+55 11 "
    strWeb = "MCP, MCTS: 2008, MCTS:MBS"
    strUserName = objuser.sAMAccountName
    
    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,1,2
     Set objTable = objDoc.Tables(1)
    
    End With
    
    Set objSignatureObject = objEmailOptions.EmailSignature
    Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
    
    With objSelection
    
    objTable.Rows.Add()
       
       objTable.Cell(2, 1).Range.InlineShapes.AddPicture "C:\Users\Administrator\Pictures\logo.jpg",true,True
       objTable.Columns(1).Width = objWord.InchesToPoints(1)
       
       objTable.Cell(2, 2).Select
       With .Font
      .Name = "Verdana"
      .Size = 10
      .Bold = True
      .Color = 0
       End With
      .TypeText strName & Chr(11)
      '.TypeParagraph()
    
     With .Font
      .Name = "Verdana"
      .Size = 8
      .Bold = False
      .Italic = False
      .Color = 0
     End With
      .TypeText strTitle & Chr(11) & strWeb & Chr(11) & "Tel. " & strPhone & Chr(11) & "Cel. " & strMobile & Chr(11) & "Skype/Gtalk. " & strFax & Chr(11) 
      objTable.Columns(2).Width = objWord.inchesToPoints(0) 
    
    objSelection.EndKey END_OF_STORY  
    
      objSelection.Font.Name = "Verdana"
      objSelection.Font.Size = "8"
      objSelection.Font.italic = true
      objSelection.Font.Color = Black
      objSelection.Font.Bold = False 
      objSelection.TypeText "Esta mensagem e seus anexos são confidenciais e talvez privilegiados. Se você não é o destinatário, por favor notifique o remetente imediatamente e não divulgue o conteúdo para terceiros, tampouco use para outros propósitos ou armazene tais informações."
      .TypeText Chr(11)
      .TypeText Chr(11)
      objSelection.Font.italic = true
      objSelection.Font.Color = 240240  
      objSelection.Font.Bold = False 
      objSelection.TypeText "* PENSE NA NATUREZA ANTES DE IMPRIMIR."
    
    
     End With
    
    
    
    Set objSelection = objDoc.Range()
    objSignatureEntries.Add "Padrao Edson Fagundes", objSelection
    objSignatureObject.NewMessageSignature = "Padrao Edson Fagundes"
    objSignatureObject.ReplyMessageSignature = "Padrao Edson Fagundes"
    msgbox ("TESTE")
    'objDoc.SaveAs "C:\Users\Administrator\Pictures\Junior.htm", wdFormatHTML
    objDoc.Saved = True
    objword.Quit
    
    'Dim FileName, Find, ReplaceWith, FileContents, dFileContents
    
    'Find     = "" & strUserName &"_arquivos/image001.gif"
    'ReplaceWith = "file://///servidor/sys/assinaturas/" & strUserName & "_arquivos/image001.gif"
    'FileName   = "\\servidor\sys\assinaturas\" & strUserName & ".htm"
    
    'Read source text file
    'FileContents = GetFile(FileName)
    
    'replace all string In the source file
    'dFileContents = replace(FileContents, Find, ReplaceWith, 1, -1, 1)
    
    'Compare source And result
    'if dFileContents <> FileContents Then
     'write result If different
     ' WriteFile FileName, dFileContents
     'If Len(ReplaceWith) <> Len(Find) Then 'Can we count n of replacements?
     ' End If
    'Else
     ' Wscript.Echo "Arquivo de assinatura nao encontrado favor entrar em contato com a TI"
    'End If
    
    'Read text file
    'function GetFile(FileName)
     ' If FileName<>"" Then
     ' Dim FS, FileStream
      ' Set FS = CreateObject("Scripting.FileSystemObject")
      ' on error resume Next
       ' Set FileStream = FS.OpenTextFile(FileName)
       'GetFile = FileStream.ReadAll
     'End If
    'End Function
    
    'Write string As a text file.
    'function WriteFile(FileName, Contents)
     ' Dim OutStream, FS
    
     ' on error resume Next
    ' Set FS = CreateObject("Scripting.FileSystemObject")
     ' Set OutStream = FS.OpenTextFile(FileName, 2, True)
      ' OutStream.Write Contents
    'End Function
    



    Espero ajudar Abraços.


    Edson Matias Fagundes Junior (Nioks)
    • Marcado como Resposta alberto batista quinta-feira, 20 de outubro de 2011 17:58
    quarta-feira, 3 de agosto de 2011 02:26
  • Edson, como você trata acentuação com o vbscript... peguei o exemplo que você deu porém não exibe corretamente as palavras acentuadas!


    Rodrigo

    quinta-feira, 25 de julho de 2013 13:14