Макрос Outlook для удаления текста и вставки подписи

Question

(Примечание: я никогда раньше не связывался с VBA; извините за возможно ужасный код!)

Я пытаюсь создать макрос, который сначала удаляет абзацы, содержащие определенные термины (жестко запрограммированные в макросе), затем устанавливает тип электронной почты в HTML и вставляет подпись по умолчанию в конце.

Я застрял на одном последнем вопросе: когда я использую InsertFile, он заменяет всю электронную почту с подписью вместо добавления его. Есть идеи?

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

У вас есть код, который можно изменить, чтобы использовать метод в ссылке из комментария 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