Outlook macro to remove text and insert signature

2

(Note: I've never messed with VBA before; sorry for probably terrible code!)

I'm trying to make a macro that first removes paragraphs containing specific terms (hardcoded into the macro), then sets the email type to HTML, and inserts the default signature at the end.

I'm stuck on one final issue: When I use InsertFile, it replaces the entire email with the signature instead of appending it. Any ideas?

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

NotSoSuperuser

Posted 2014-12-16T10:41:21.113

Reputation: 21

take a look here – Raystafarian – 2014-12-16T12:34:42.270

Answers

0

The code you have can be modified to use the method in the link from the comment https://stackoverflow.com/questions/8994116/how-to-add-default-signature-in-outlook

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

niton

Posted 2014-12-16T10:41:21.113

Reputation: 1 724