Runtime error when using SaveAsFile method to save Outlook..

External Since: Mar 01, 2008 Posts: 5

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

External Since: Oct 17, 2003 Posts: 2898

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" <confused2 DeleteThis @discussions.microsoft.com> wrote in message
news:A0E72AC0-4FB4-492E-ACC3-F9200F8B4277@microsoft.com...
> 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
>