View Single Post
  #6  
Old April 8th 08, 02:48 AM posted to microsoft.public.outlook.program_vba
confused2
external usenet poster
 
Posts: 5
Default Runtime error when using SaveAsFile method to save Outlook att

Hi Ken,

Have checked but that folder doesn't exist on the pc. The weird thing is
that the problem doesn't occur when the macro works on a bunch of e-mails
with only 1 attachment (I've tried with over 800+ attachments and not a
single macro crash). It might also have something to do with the ATT0001.txt
attachment filename so will try renaming the attachment later. Many thanks
again for all your assistance - very much appreciated.

B/Rgds

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

The only other thing I can think of is that what you're doing it filling the
Outlook secure temp folder for some reason. Take a look there and see if
things work better if you delete the files in that folder. You can find it
by following the directions he http://support.microsoft.com/kb/817878.
Make sure to substitute your version of Outlook for the "11.0". Outlook 2007
would be "12.0".

--
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
...
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



Ads