![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Printing in Outlook I get a Runtime Error 2012. | Captainhelo | Outlook - Installation | 0 | September 19th 06 03:38 PM |
Outlook Runtime Error | Lorna | Outlook - General Queries | 2 | September 12th 06 09:40 AM |
Runtime error 80004005 Creating Outlook.Application | Dave | Add-ins for Outlook | 6 | July 18th 06 11:18 PM |
SaveAsFile - save as subject line instead of DisplayName | iamjbunni | Outlook and VBA | 1 | April 30th 06 09:54 AM |
Runtime error in opening Outlook 2002 | Ajay Bankoti | Outlook - Installation | 0 | March 3rd 06 12:34 PM |