Macro help to replace Outlook Paragraph ^p with return ^l when using Number Lists

The macro below is NOT mine and I don't know who to give credit to, but thank you for the starting point.

It works for all all but messages containing Bullets or Number list (Outline) formatting.

Is there a better VBA macro to automatically replace ^p with ^l when using Bullets and Number Lists in Outlook 2010 under Win 7
If not, what must be changed/modified below to allow for Bullets and Number lists?
i.e.

1. indent 1
   
   1. Indent 2
      
      1. Etc
      
      
   
   

' ****************MACRO***************

Public FormatKey As Boolean
Sub Application_Startup() ' This routine runs when Outlook is started
FormatKey = True ' Reformatting is enabled when Outlook is started
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objNS As Outlook.NameSpace
Set objOL = Application

' Add reference to Word library
' in VBA Editor, Tools, References
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection

On Error Resume Next

Set objNS = objOL.Session

'Reference the current Outlook item
Set objItem = Application.ActiveInspector.CurrentItem
If (Not objItem Is Nothing And FormatKey) Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then

Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
objWord.Selection.WholeStory
Set objSel = objWord.Selection

objSel.Find.ClearFormatting
objSel.Find.Replacement.ClearFormatting

With objSel.Find
.Text = "^p"
.Replacement.Text = "^l"
' .Forward = True
.Forward = False
.Wrap = wdFindContinue
' .Format = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objSel.Find.Execute Replace:=wdReplaceAll

End If
End If
End If



If (1 = 2) Then ' Remove this and uncomment next
' If (objItem.BodyFormat = olFormatHTML And FormatKey) Then ' message format is HTML and reformatting is enabled
xstr = objItem.HTMLBody ' Get the body of the message into xstr

''''''' FOR DEBUGGING - Uncomment this to view original HTML code generated by Outlook ''''''''
' Open "c:\temp\OutlookHTMLoriginal.txt" For Output As #1
' Print #1, xstr
' Close #1
''''''' END DEBUGGING CODE ''''''''
match1 = "<o:p></o:p>" ' strings of stuff Outlook generates for paragraph tag
Lmatch1 = Len(match1)

L = Len(xstr)
j = 0 ' input string counter
ystr = ""
Do While (j <= L) ' examine each character in body of message

j = j + 1

If (j <= L - (Lmatch1 - 1) And Mid(xstr, j, Lmatch1) = match1) Then ' A paragraph tag was found
ystr = ystr & "" ' change it to a break tag
j = j + (Lmatch1 - 1) ' skip checking the rest of the paragraph tag
Else
ystr = ystr & Mid(xstr, j, 1) ' Just copy the input character to output string
End If

Loop

''''''' FOR DEBUGGING - Uncomment this to view reformatted HTML code ''''''''
' Open "c:\temp\OutlookHTMLreformatted.txt" For Output As #1
' Print #1, ystr
' Close #1
''''''' END DEBUGGING CODE ''''''''

objItem.HTMLBody = ystr ' replace message body with the modified string

End If

Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objInsp = Nothing
End Sub

Sub ToggleFormatKey() ' Calling this routine toggles reformatting on or off.
If (FormatKey) Then
FormatKey = False
' CreateObject("WScript.Shell").Popup "Send reformatting is DISABLED", 1, "Microsoft Outlook", 64 + 4096
i = MsgBox("Send reformatting is DISABLED", vbOKOnly)
Else
FormatKey = True
' CreateObject("WScript.Shell").Popup "Send reformatting is ENABLED", 1, "Microsoft Outlook", 64 + 4096
i = MsgBox("Send reformatting is ENABLED", vbOKOnly)
End If
End Sub

I have not attempted to debug your code, however the following macro will replace line breaks with paragraph breaks in the current message. You can display the line breaks with CTRL+SHIFT+*

Code:

---

Option Explicit
Private Sub ReplaceLineBreaks(ByVal objItem As MailItem)
Dim objInsp As Outlook.Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objRng As Object

    ' Reference to Word library
    ' in VBA Editor, Tools, References (not required)

    'Reference the current Outlook item
    With objItem
        If .Class = olMail Then
            Set objInsp = objItem.GetInspector
            Set objDoc = objInsp.WordEditor
            Set objRng = objDoc.Range
            .Display
            With objRng.Find
                Do While .Execute(FindText:="^l")
                    objRng = vbCr
                    objRng.collapse 0
                Loop
            End With
        End If
    End With
End Sub

---

Open a message and test the macro with the following:

Code:

---

Sub test()
ReplaceLineBreaks ActiveInspector.CurrentItem
End Sub

---

It is not clear what your problem is, but this should remove replace all line breaks in the message.

Quote:

---

Originally Posted by gmayor

I have not attempted to debug your code, however the following macro will replace line breaks with paragraph breaks in the current message. You can display the line breaks with CTRL+SHIFT+*

Code:

---

Option Explicit
Private Sub ReplaceLineBreaks(ByVal objItem As MailItem)
Dim objInsp As Outlook.Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objRng As Object

    ' Reference to Word library
    ' in VBA Editor, Tools, References (not required)

    'Reference the current Outlook item
    With objItem
        If .Class = olMail Then
            Set objInsp = objItem.GetInspector
            Set objDoc = objInsp.WordEditor
            Set objRng = objDoc.Range
            .Display
            With objRng.Find
                Do While .Execute(FindText:="^l")
                    objRng = vbCr
                    objRng.collapse 0
                Loop
            End With
        End If
    End With
End Sub

---

Open a message and test the macro with the following:

Code:

---

Sub test()
ReplaceLineBreaks ActiveInspector.CurrentItem
End Sub

---

It is not clear what your problem is, but this should remove replace all line breaks in the message.

---

Thank you Graham. I'm looking to replace ALL of the ^p (Word Paragraphs) with ^l (I believe Word br ) in Outlook automaticall when I hit "send". The macro I posted does this but it also does:

• Indent 1 bullet
  
  • Indent 2 Bullet
    
    • Indent 3 Bullet
    
    
  
  

1. Numbering 1
2. Numbering 2
   
   1. Numbering 3 indent 2
      
      1. Numbering 4 indent 3
      
      
   
   

After running macro
Indent 1 bullet
Indent 2 Bullet
Indent 3 Bullet
Numbering 1
Numbering 2
Numbering 3 indent 2
Numbering 4 indent 3

I'm not sure why it removes the indentions as well as replacing the ^p with ^l.

I hope this makes more sense. This is my first endeavor to implement a VBA macro in Outlook. I thought simply automating a "replace all" would do it, but it makes a mess out of my outlines, as does the manual "replace all".

I will try to change your macro to the following, but I'm not sure how to activate it yet.
With objRng.Find
Do While .Execute(FindText:="^p")
objRng = "^l"
objRng.collapse 0
Loop

Thanks,
Ken

I got the replacements the wrong way round (as that seemed more logical), however if you change the paragraph breaks to line breaks, then instead of having a series of numbered or bulleted paragraphs, you will have one long paragraph and the paragraph numbering/bulleting will not apply. You would need to replace ^p with vbLf and not ^l using this method i.e.

Code:

---

          With objRng.Find
                Do While .Execute(FindText:="^p")
                    objRng = vbLf
                    objRng.collapse 0
                Loop
            End With

---

What is the point of this exercise?

Quote:

---

Originally Posted by gmayor

I got the replacements the wrong way round (as that seemed more logical), however if you change the paragraph breaks to line breaks, then instead of having a series of numbered or bulleted paragraphs, you will have one long paragraph and the paragraph numbering/bulleting will not apply. You would need to replace ^p with vbLf and not ^l using this method i.e.

Code:

---

          With objRng.Find
                Do While .Execute(FindText:="^p")
                    objRng = vbLf
                    objRng.collapse 0
                Loop
            End With

---

What is the point of this exercise?

---

When I send an email written with Outlook to other readers or to a Yahoo group every time I hit "Enter" it displays a double line feed to the recipient. I have tried changing style to 2003 and adjusting the line spacing, but nothing works; so I thought maybe this would bring me back to the stone-age where one enter = one cf/lf. Maybe I'm expecting too much with Word/Outlook.

I will try your suggestion.

Thanks!!!
Ken

With your cursor in the body of the message, click CTRL+SHIFT+* to toggle the display of paragraph breaks. How many breaks ( ¶ ) are there between paragraphs? If there is one, then the problem relates to the way the third party applications display messages. If two then you need to ensure there is only one.