View Single Post
  #1  
Old October 12th 07, 07:37 PM posted to microsoft.public.outlook.program_vba
Chris Weirup
external usenet poster
 
Posts: 1
Default Outlook 2007 - Error Inserting Text into Received E-mail

I have a VBA macro for handling e-mail attachments in Outlook 2007 (based on
the version from Nicola Delfino). The macro saves any attachments in an
e-mail highlighted in the Inbox, then deletes them, and finally adds a line
of text into the original e-mail with the path where the file saves (see code
below). The macro handles the first two tasks fine, but then I receive the
following error when I try to add the text to the message:

Error Number: 4605
Error Description: This method or property is not available because the
document is locked for editing.

This happens when the text is being inserted into the e-mail message. When
I'm debugging the code, I've noticed that many of the WordEditor properties
are locked and unavailable. How do I unlock the underlying Word.Document
properties and add the text?

Thanks!
- Chris

CODE:
Public Sub StripAttachments()

Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolder As String
Dim result

On Error GoTo StripAttachments_err

result = MsgBox("Do you want to remove attachments from selected
email(s)?", vbYesNo + vbQuestion)
If result = vbNo Then
Exit Sub
End If

' Instantiate an Outlook Application object.
' Set objOL = CreateObject("Outlook.Application")
Set objOL = Application
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the folder to save attachements
' Need a better way of doing this - maybe dialog box
strFolder = "D:\Data\Outlook_Attachments\"

' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
strFile = ""
For i = lngCount To 1 Step -1
' Get the file name.
strFile = strFile & strFolder &
objAttachments.Item(i).FileName

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

' Delete the attachment.
objAttachments.Item(i).Delete
Next i

Dim objDoc As Object
Dim objInsp As Outlook.Inspector
Set objInsp = objMsg.GetInspector
Set objDoc = objInsp.WordEditor

objDoc.Characters(1).InsertBefore strFile
objDoc.Save

End If
End If
Next

ExitSub:
Set objDoc = Nothing
Set objInsp = Nothing
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

Exit Sub

StripAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: StripAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
& vbCrLf & "Error Source: " & Err.Source _
, vbCritical, "Error!"

GoTo ExitSub
End Sub

Ads