Running a Word VBA macro in an Outlook 2016 message to remove duplicate paragraphs

Question

I am trying to adapt some MS Word VBA macros to run in Outlook 2016. I wonder if anyone can help me adapt the macro reproduced below, by Tomalak? (See Q 33562468)

Within Outlook I have referenced the Microsoft Word 16.0 Object Library, and I have tried to use the suggestions at http://www.vboffice.net/en/developers/use-word-macro-in-outlook/ and https://www.slipstick.com/developer/word-macro-apply-formatting-outlook-email/ but without success.

The purpose of the original VBA was to remove duplicate paragraphs which it does in Word. I want to adapt it to perform the same function on an email message which is open and being edited within Outlook 2016.

The VBA when run in Word deletes all but one instance of each duplicated paragraph; the first instance (the one nearest the top of the document) is retained. I would prefer that instead the last instance (the one nearest the foot of the document) is retained.

Sub DeleteDuplicateParagraphs()
  Dim p As Paragraph
  Dim d As New Scripting.Dictionary
  Dim t As Variant
  Dim i As Integer
  Dim StartTime As Single

  StartTime = Timer

  ' collect duplicates
  For Each p In ActiveDocument.Paragraphs
    t = p.Range.Text
    If t <> vbCr Then
      If Not d.Exists(t) Then d.Add t, New Scripting.Dictionary
      d(t).Add d(t).Count + 1, p
    End If
  Next

  ' eliminate duplicates
  Application.ScreenUpdating = False
  For Each t In d
    For i = 2 To d(t).Count
      d(t)(i).Range.Delete
    Next
  Next
  Application.ScreenUpdating = True

  MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " 
 seconds", vbInformation
End Sub

Welcome to Stack Overflow! Don't forget to take the tour and "How to Ask". msdn.microsoft.com/en-us/vba/outlook-vba/articles/… and vboffice.net/en/developers/use-word-macro-in-outlook — ashleedawg
Instead of using For...Each over the paragraphs, use a For...Next loop counting back from the last paragraph: if you've already got the text in your dictionary you can delete the current one. — Tim Williams
Thanks Tim. I'm not sure how I would go about replacing the For Each.....with a For...Next. — Mike
I have now been able to adapt the code to run in Outlook, by replacing Paragraph with Word.Paragraph and replacing ActiveDocument.Paragraphs by objDoc.Paragraphs, and by inserting the amended code into Diane Poremsky's proposed code (link above). — Mike
...and to have the last duplicate paragraph retained instead of the first, change "For i=2 to d(t).Count" To "For i=1 to d(t).Count-1". Job done. Thanks Tomalak for the original code. — Mike

Mike Mike · Accepted Answer · 2018-07-18T15:31:05

To make Tomalak's Word VBA code compatible with Outlook I replaced "Paragraph" with "Word.Paragraph" and "ActiveDocument.Paragraphs" with "objDoc.Paragraphs", and inserted the amended code into Diane Poremsky's proposed Word-to-Outlook VBA code adaptor (link above). To retain the last duplicate paragraph instead of the first, I changed "For i=2 to d(t).Count" to "For i=1 to d(t).Count-1".

Running a Word VBA macro in an Outlook 2016 message to remove duplicate paragraphs

1 Answers