G
Guest
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
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