I changed some codes for getting selected messages attachments to my hard drive like below :
Public Sub SaveAttachments() Dim objOL As Outlook.Application Dim objMsg As Outlook.MailItem 'Object Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim I As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Dim strDeletedFiles As String Dim Counter As Long strFolderpath = "D:\attachments" If (Dir$(strFolderpath, vbDirectory) = "") Then MsgBox "'" & strFolderpath & "' not exist" MkDir strFolderpath MsgBox "'" & strFolderpath & "' we create it" Else MsgBox "'" & strFolderpath & "' exist" End If ' Get the path to your My Documents folder 'strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) strFolderpath = strFolderpath & "\" On Error Resume Next ' Instantiate an Outlook Application object. Set objOL = CreateObject("Outlook.Application") ' Get the collection of selected objects. Set objSelection = objOL.ActiveExplorer.Selection ' The attachment folder needs to exist ' You can change this to another folder name of your choice ' Set the Attachment folder. strFolderpath = strFolderpath ' Check each selected item for attachments. Counter = 1 For Each objMsg In objSelection Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count If lngCount > 0 Then ' Use a count down loop for removing items ' from a collection. Otherwise, the loop counter gets ' confused and only every other item is removed. For I = lngCount To 1 Step -1 ' Get the file name. strFile = objAttachments.Item(I).FileName ' Combine with the path to the Temp folder. strFile = strFolderpath & Counter & "_" & strFile ' Save the attachment as a file. objAttachments.Item(I).SaveAsFile strFile Counter = Counter + 1 Next I End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing MsgBox "All Selected Attachments Have Been Downloaded ..." End Sub
my goal email uses imap service...
this vb codes works perfect!
but my problem is when download is finished we have not needed files in attachments folder!
I have 450 UNREAD emails in my inbox that all of them have attachmen/s...
but we have only 200 files in attachments folder! (created by upper codes)
how can I fix this issue?
it seems this problem is in relationship with Unread Messages And My ADSL speed (but it should n't , I don't know?!)
when u read an email it seems Outlook does some stuff with that email and so next time that email runs faster because of it's caching.
how can I do this job for my unread emails with upper codes?
or is there any idea about this problem?
at last I would be really appreciate for review and add or correct my codes