☰

Outlook 宏删除文本并插入签名

tag-icon • tag-icon email microsoft-outlook vba macros
Outlook 宏删除文本并插入签名

（注意：我以前从未使用过 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

答案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

相关内容