I've now got the olHTMLEditor part working, but the olRTFEditor
part (using Redemption RTFEditor) isn't inserting any text. This
case statement is arrived at when processing a message created
using Rich Text format (not using Word editor).

Here's the code:

Private Sub InsertLines(olSMailItem As Redemption.SafeMailItem,
sLines() As String)
Dim olEditButton As Office.CommandBarButton
Dim olSInsp As Redemption.SafeInspector
Dim olRTFEditor As Redemption.RTFEditor
Dim wdDoc As Word.Document 'Requires
Microsoft Word Object Library reference
Dim mDoc As MSHTML.HTMLDocument 'Requires
Microsoft HTML Object Library reference
Dim mElement As MSHTML.IHTMLElement

'On Error Resume Next

Set olSInsp = New Redemption.SafeInspector
olSInsp.Item = olSMailItem.GetInspector

Select Case olSInsp.EditorType

Case olEditorHTML

'Edit message

Set olEditButton =
Application.ActiveInspector.CommandBars.FindContro l(, 5604)
olEditButton.Execute

DoEvents

Set mDoc = olSInsp.HTMLEditor
Set mElement = mDoc.Body.all(0)

mElement.insertAdjacentHTML "beforeBegin", _
"P style=""font-family: Arial; font-size: 10pt;
color: blue""" & _
Join(sLines, "BR") & _
"/P"

Case olEditorRTF

'-- This correctly inserts the text lines in default
font (Arial 10pt black), but I want them to be in
'-- Arial 10pt blue
'olSInsp.SelText = Join(sLines, vbNewLine) & " " &
vbNewLine

'-- Therefore use Redemption RTFEditor
'-- This should insert the text lines in Arial 10pt
blue, but it doesn't insert any lines
Set olRTFEditor = olSInsp.RTFEditor
olRTFEditor.RTFSelText = Join(sLines, vbNewLine) & "
" & vbNewLine
olRTFEditor.SelAttributes.Name = "Arial"
olRTFEditor.SelAttributes.Size = 12
olRTFEditor.SelAttributes.Color = vbBlue

Case olEditorText

olSInsp.SelText = Join(sLines, vbNewLine) & " " &
vbNewLine

Case olEditorWord

'-- UNTESTED
Set wdDoc = olSInsp.WordEditor
wdDoc.Characters(1).InsertBefore Join(sLines,
vbNewLine) & " " & vbNewLine

Case Else

MsgBox "Unrecognised EditorType: " &
olSInsp.EditorType & vbNewLine & vbNewLine & _
"Unable to insert text in message"

End Select

End Sub


Any ideas why the RTFEditor code above isn't inserting any lines?

Also, how do I create email messages in olEditorWord format to
test that? So far the 3 types of message format (HTML, RTF and
Plain Text) I've been able to create are handled by their
respective case statements.

thanks,

"JW" wrote in message
...
Hi,

Outlook 2003 SP3, Windows XP Pro SP2.

I've written the VBA code below to remove attachments from the
selected email(s) and insert a list of the filenames removed at
the top of the message using the Redemption SafeMailItem and
SafeInspector objects. However it crashes at the line:

olSInsp.SelText = sText

With the error:

Run-time error '-2147467259 (80004005)':
Unspecified Error

If I then click Help it says 'Automation error (Error 440)'.

The program works fine if I step through it in the VBA
debugger, or if I display a message box before the line, i.e.
MsgBox ""

Any ideas where I'm going wrong and how to fix it?

Many thanks.

--------------- Start of code -----------------
Option Explicit

Sub Remove_Attachments()
Dim olMailItem As Outlook.MailItem
Dim olSMailItem As Redemption.SafeMailItem
Dim olAttachments As Outlook.Attachments
Dim sText As String
Dim i As Integer

Const removeAttachments As Boolean = False

Set olSMailItem = New Redemption.SafeMailItem

For Each olMailItem In ActiveExplorer.Selection

If olMailItem.Class = olMail Then

olSMailItem.Item = olMailItem
Set olAttachments = olSMailItem.Attachments

If olAttachments.Count 0 Then

sText = Now() & " removed attachments:" &
vbNewLine & " " & vbNewLine

If removeAttachments Then

'Delete each attachment and create the text
string to insert in the message

While olAttachments.Count 0
sText = sText &
olAttachments(1).fileName & vbNewLine
olAttachments(1).Delete
Wend

Else

'Testing only. Don't delete attachments -
just create the text string to insert in the message

For i = 1 To olAttachments.Count
sText = sText &
olAttachments(i).fileName & vbNewLine
Next
End If

olSMailItem.Display

InsertText olSMailItem, sText

olSMailItem.Close olSave

End If
End If
Next

End Sub

Private Sub InsertText(olSMailItem As Redemption.SafeMailItem,
sText As String)
Dim olSInsp As Redemption.SafeInspector
Dim olEditButton As Office.CommandBarButton

'On Error Resume Next

'Edit message

Set olEditButton =
Application.ActiveInspector.CommandBars.FindContro l(, 5604)
olEditButton.Execute

Set olSInsp = New Redemption.SafeInspector
olSInsp.Item = olSMailItem.GetInspector

'The next line crashes with:
' Run-time error '-2147467259 (80004005)':
' Unspecified Error
'Click Help and it says 'Automation error (Error 440)'
olSInsp.SelText = sText

Set olEditButton = Nothing
Set olSInsp = Nothing

End Sub
--------------- End of code -----------------