![]() |
|
#1
|
|||
|
|||
![]()
Hello,
I need to copy all attachments from an email folder of approximately 2000 emails over 5 different folders, where if the filename is the same, I want to replace the current file only if the file creation date is newer so I have the latest version. I have this command which copys the files accordingly but I do not know how to set the replace command. Code:
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 ' Get the path to your My Documents folder strFolderpath = "\\Norprint-srv-06\Magnadata\Odin\Old Files\SALES\CSE_files\proofs\test\" 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 ' Set the Attachment folder. strFolderpath = "\\Norprint-srv-06\Magnadata\Odin\Old Files\SALES\CSE_files\proofs\test\" ' Check each selected item for attachments. If attachments exist, ' save them to the strFolderPath folder and strip them from the item. For Each objMsg In objSelection ' This code only strips attachments from mail items. ' If objMsg.class=olMail Then ' Get the Attachments collection of the item. Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count strDeletedFiles = "" If lngCount > 0 Then ' We need to 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 ' Save attachment before deleting from item. ' Get the file name. strFile = objAttachments.Item(i).FileName ' Combine with the path to the Temp folder. strFile = strFolderpath & strFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strFile 'write the save as path to a string to add to the message 'check for html and use html tags in link If objMsg.BodyFormat <> olFormatHTML Then strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" Else strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ strFile & "'>" & strFile & "</a>" End If 'Use the MsgBox command to troubleshoot. Remove it from the final code. 'MsgBox strDeletedFiles Next i ' Adds the filename string to the message body and save it ' Check for HTML body If objMsg.BodyFormat <> olFormatHTML Then objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body Else objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody End If objMsg.Save End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub Last edited by terrymac; 11-23-2015 at 03:02 AM. Reason: Title amended |
#2
|
||||
|
||||
![]()
My understanding of the process is that you will have to save the attachment to the hard drive in order to read the creation date, which will thus always be newer than the last saved version as the creation date will be the date you save it from attachment to folder. For this reason I would advocate saving all attachments with unique names to avoid the issue of overwriting required data. If you process the messages as they arrive, using a rule, then surely you should also have the latest version of the file? You will have to modify your code to use it as a script for use with a rule.
You can use the FileNameUnique function at http://www.gmayor.com/useful_vba_functions.htm to provide unique names for the attachments.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
terrymac | Outlook | 1 | 11-12-2015 06:55 AM |
![]() |
Ravi786 | Outlook | 1 | 10-21-2015 12:38 AM |
Save and send command | SGTrader | Excel | 0 | 08-20-2014 08:34 AM |
Save attachments to defined path via VBA | eltonlaw | Outlook | 7 | 07-03-2014 04:59 PM |
![]() |
unit213 | Outlook | 1 | 09-26-2007 08:15 PM |