![]() |
#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 |
|
![]() |
||||
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 |