J
JW
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.FindControl(, 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 -----------------
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.FindControl(, 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 -----------------