Macro do Outlook para remover texto e inserir assinatura

Question

(Nota: eu nunca mexi com o VBA antes; desculpe pelo código provavelmente terrível!)

Estou tentando criar uma macro que primeiro remova parágrafos contendo termos específicos (codificados permanentemente na macro), depois defina o tipo de email como HTML e insira a assinatura padrão no final.

Estou preso a um problema final: quando uso o InsertFile, ele substitui todo o email pela assinatura em vez de anexá-lo. Alguma idéia?

Sub Function()

'Import Word functions and search & remove

Dim Ins As Outlook.Inspector
Dim Document As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection

Set Ins = Application.ActiveInspector
Set Document = Ins.WordEditor
Set Word = Document.Application
Set Selection = Word.Selection

  Dim search As String
  search = "search term 1"
  Dim search2 As String
  search2 = "search term 2"

  Dim para As Paragraph
  For Each para In Document.Paragraphs

      Dim txt As String
      txt = para.Range.Text

      If InStr(txt, search) Or InStr(txt, search2) Then
          para.Range.Delete
      End If

  Next

'Set to HTML

Dim objItem As Object
Dim objMail As MailItem
On Error Resume Next

Set objItem = Application.ActiveInspector.CurrentItem
If Not objItem Is Nothing Then
    If objItem.Class = olMail Then
        ActiveInspector.CommandBars.ExecuteMso ("MessageFormatHtml")
    End If
End If

'Get and insert default HTML signature

Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
    Signature = Signature & Dir$(Signature & "*.htm")
Else:
    Signature = ""
End If

Document.Range.InsertParagraphAfter
Document.Range.InsertFile Signature, , False, False, False

End Sub

    

Answer 1

O código que você tem pode ser modificado para usar o método no link do comentário link

Sub DeleteTextAddSignature()

'Import Word functions and search & remove

Dim Ins As Outlook.Inspector
Dim Document As Word.Document
Dim Word As Word.Application
Dim Selection As Word.Selection

Set Ins = Application.ActiveInspector
Set Document = Ins.WordEditor
Set Word = Document.Application
Set Selection = Word.Selection

Dim search As String
search = "search term 1"
Dim search2 As String
search2 = "search term 2"

Dim para As Paragraph
For Each para In Document.Paragraphs

    Dim txt As String
    txt = para.Range.Text

    If InStr(txt, search) Or InStr(txt, search2) Then
        para.Range.Delete
    End If

Next

'Set to HTML

Dim objItem As Object
Dim objMail As mailitem
On Error Resume Next

Set objItem = Application.ActiveInspector.currentItem
If Not objItem Is Nothing Then
    If objItem.Class = olMail Then
        ActiveInspector.CommandBars.ExecuteMso ("MessageFormatHtml")
    End If
End If

'Get and insert default HTML signature
Dim Signature

Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
    Signature = Signature & Dir$(Signature & "*.htm")
    Signature = GetBoiler(Signature)
Else:
    Signature = ""
End If

With objItem
    .HTMLBody = .HTMLBody & Signature
End With

objItem.Display

Set objItem = Nothing

End Sub

' http://www.rondebruin.nl/win/s1/outlook/signature.htm

Private Function GetBoiler(ByVal sFile As Variant) As Variant
    Dim FSO
    Dim ts
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ts = FSO.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function