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