Hi Ken,

Have amended the code as follows but the error still occurs on the 200th
attachment. Runtime error looks like;

===========================
Run-time error '-71286779 (fbc04005)':

Cannot save the attachment. Can't create file: ATT00001.txt. Right-click the
folder you want to create the file in, and then click Properties on the
shortcut menu to check your permissions for the folder.
===========================

I've tried this code on another colleagues PC (also no success) and ensured
basic items like sufficient disk space. Appreciate if you can think of
anything else I could try. Otherwise, I'll try to break up the loop to a
specific no. of items per your worst case suggestion. Many thanks again for
your help.

B/Rgds

Public Sub SaveAttachmentsNew()

'Note, this assumes you are in the a folder with e-mail messages when you
run it.
'It does not have to be the inbox, simply any folder with e-mail messages

'Dim App As New Outlook.Application
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.Selection

Dim AttachmentCnt As Long
Dim AttTotal As Long
Dim MsgTotal As Long
Dim i As Long

Set Exp = Application.ActiveExplorer
Set Sel = Exp.Selection
Dim Count As Long
lCount = Sel.Count
i = 1

'Loop thru each selected item in the inbox
For cnt = 1 To lCount
'If the e-mail has attachments...
Dim myItem
Dim myAttCount As Long
Set myItem = Sel.Item(cnt)
myAttCount = Sel.Item(cnt).Attachments.Count

'If Sel.Item(cnt).Attachments.Count 0 Then
If myAttCount 0 Then
MsgTotal = MsgTotal + 1
'AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count
AttTotal = AttTotal + myAttCount

'For each attachment on the message...
'For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count

For AttachmentCnt = 1 To myAttCount
'Get the attachment
Dim att As Attachment
Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
'att.SaveAsFile ("C:\Attachments\" &
Format(Sel.Item(cnt).CreationTime, "yyyymmdd_hhnnss_") & Str(i) & "_" &
att.FileName & ".txt")
att.SaveAsFile ("C:\Attachments\" & Format(myItem.CreationTime,
"yyyymmdd_hhnnss_") & Str(i) & "_" & att.FileName & ".txt")
Set att = Nothing
i = i + 1
Next
End If

'Set myAttCount = Nothing
Set myItem = Nothing

Next

'Clean up
Set Sel = Nothing
Set Exp = Nothing
'Set App = Nothing

'Let user know we are done
Dim doneMsg As String
doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments
in " + Format$(MsgTotal, "#,0") + " Messages."
MsgBox doneMsg, vbOKOnly, "Save Attachments"

Exit Sub

ErrorHandler:

Dim errMsg As String
errMsg = "An error has occurred. Error " + Err.Number + " " +
Err.Description
Dim errResult As VbMsgBoxResult
errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
Select Case errResult
Case vbAbort
Exit Sub

Case vbRetry
Resume

Case vbIgnore
Resume Next

End Select

End Sub



"confused2" wrote:

Hi Ken,

Many thanks for the really quick reply. Sorry I didn't specify earlier -
this macro operation is performed on data in a local PST file. Will try to
work through your suggestions slowly (am only a beginner when it comes to VBA
programming). Very much appreciate your assistance.

B/Rgds

"Ken Slovak - [MVP - Outlook]" wrote:

Is this against Exchange server? It sounds like you're running into the open
RPC channel limit when accessing Exchange data, usually set at about 255
open channels.

To avoid this explicitly instantiate objects for each dot operator you are
using and then set the objects to null for each pass through the loop. For
example, instead of using Sel.Count use this:

Dim Count As Long
lCount = Sel.Count
For cnt = 1 To lCount

Don't use Sel.Item(cnt), use myItem = Sel.Item(cnt) and then work with
myItem. Same for things like Sel.Item(cnt).Attachments.Count.

When you use dot operators Outlook internally creates variables for each dot
operator and doesn't release them until the procedure finishes. So you want
to minimize that and to explicitly release the objects each pass in the
loop.

Worst case you might have to limt things to say 100 passes of the loop and
to call the loop multiple times to process everything.

If this code is running inside the Outlook VBA project do not use Dim App As
New Outlook.Application, instead use the trusted, intrinsic Application
object which will be trusted and will automatically have an
Outlook.Application reference.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"confused2" wrote in message
...
Attached macro is used to save all attachments for selected e-mail items
in a
particular outlook folder. Code works fine, however after 199 items are
saved
in c:\attachments folder - a runtime error occurs (something about unable
to
save the file). A bit confused why this is occurring and would appreciate
some guidance. Many thanks.

Public Sub SaveAttachmentsNew()

'Note, this assumes you are in the a folder with e-mail messages when you
run it.
'It does not have to be the inbox, simply any folder with e-mail messages

Dim App As New Outlook.Application
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.Selection

Dim AttachmentCnt As Integer
Dim AttTotal As Integer
Dim MsgTotal As Integer
Dim i As Integer

Set Exp = App.ActiveExplorer
Set Sel = Exp.Selection
i = 1

'Loop thru each selected item in the inbox
For cnt = 1 To Sel.Count
'If the e-mail has attachments...
If Sel.Item(cnt).Attachments.Count 0 Then
MsgTotal = MsgTotal + 1
AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count
'For each attachment on the message...
For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
'Get the attachment
Dim att As Attachment
Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
att.SaveAsFile ("C:\Attachments\" &
Format(Sel.Item(cnt).CreationTime, "yyyymmdd_hhnnss_") & Str(i) & "_" &
att.FileName & ".txt")
Set att = Nothing
i = i + 1
Next
End If
Next

'Clean up
Set Sel = Nothing
Set Exp = Nothing
Set App = Nothing

'Let user know we are done
Dim doneMsg As String
doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments
in " + Format$(MsgTotal, "#,0") + " Messages."
MsgBox doneMsg, vbOKOnly, "Save Attachments"

Exit Sub

ErrorHandler:

Dim errMsg As String
errMsg = "An error has occurred. Error " + Err.Number + " " +
Err.Description
Dim errResult As VbMsgBoxResult
errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save
Attachments")
Select Case errResult
Case vbAbort
Exit Sub

Case vbRetry
Resume

Case vbIgnore
Resume Next

End Select

End Sub