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