![]() |
#2
|
|||
|
|||
![]()
I got this working, but it only works by forwarding the draft/creating another copy of the draft email. Can it be tweaked so it does it with the existing/original draft instead?
Sub RenameAttachmentsWhenForwarding() Dim olItem As MailItem Dim Att As Attachment Dim Atts As Attachments Dim olForward As MailItem Dim FWAtt As Attachment Dim FWAtts As Attachments Dim FSO As Object Dim TempFPath As Object Dim FilePath As String Dim strName As String Dim strExten As String Dim strFile As String Set olItem = Application.ActiveInspector.CurrentItem Set Atts = olItem.Attachments Set olForward = olItem.Forward olForward.Display On Error Resume Next For Each Att In Atts 'Get the path to Temporary Folder Set FSO = CreateObject("Scripting.FileSystemObject") Set TempFPath = FSO.GetSpecialFolder(2) FilePath = TempFPath.Path & "" 'Rename the attachments strName = Replace(Att.FileName, "%20", " ") 'Change "4" based on the length of the attachment file extension strExten = Right(Att.FileName, 4) 'strFile = FilePath & strName & "." & strExten strFile = FilePath & strName If strName <> "" Then 'Save the attachments to the Temporary Folder Att.SaveAsFile (strFile) 'Add the attachments saved in new names from the Temporary Folder olForward.Attachments.Add (strFile) Set FWAtts = olForward.Attachments 'Remove the original attachments For Each FWAtt In FWAtts If InStr(FWAtt.FileName, Att.FileName) > 0 Then FWAtt.Delete End If Next End If Next End Sub |
Tags |
attachments, rename |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
AndyDDUK | Outlook | 1 | 03-01-2017 07:32 AM |
Rename attachment based on attachment name | AndyDDUK | Outlook | 1 | 03-01-2017 07:31 AM |
![]() |
Lortiz70 | Word VBA | 1 | 01-19-2017 02:48 AM |
Email sends mailmerge file behind email rather than attachment | TLC1974 | Mail Merge | 2 | 07-22-2016 12:53 AM |
![]() |
Nexus | Mail Merge | 12 | 04-13-2011 11:34 PM |