Rename attachment in draft email

JamesMWood · #1 01-25-2023, 03:39 AM

Hiya

If you have a draft email with some attachments, is it possibly to write a macro that can find and replace a certain word in the filenames of all attachments?

Thanks!

James

JamesMWood · #2 01-25-2023, 07:05 AM

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

gmayor · #3 01-25-2023, 10:23 PM

The only ways to do it are to extract the attachments to a temporary location and then re-add them to the message, or to rename the attachment items (or copies of them), before adding them in the first place.

JamesMWood · #4 01-26-2023, 01:10 AM

Quote:

Originally Posted by gmayor

The only ways to do it are to extract the attachments to a temporary location and then re-add them to the message, or to rename the attachment items (or copies of them), before adding them in the first place.

Thanks for your reply!

Yup I got it to work in my code above - essentially I just needed %20 replacing with a space. The only issue with the code now is that it has to forward the email/create a new version of the draft, instead of doing it to the existing one. Any thoughts on the code above? Thanks a lot!

JamesMWood · #5 01-27-2023, 01:02 AM

Any ideas anyone? Thanks

gmayor · #6 01-27-2023, 05:40 AM

olItem is the original message, so why create the new one olForward? Re-attach back to olItem.

JamesMWood · #7 01-27-2023, 07:04 AM

Quote:

Originally Posted by gmayor

olItem is the original message, so why create the new one olForward? Re-attach back to olItem.

I've tried it, but for some reason it seems to delete more than it should and then doesn't include all of the newly-renamed files. I'm missing something

If you have any ideas on the code, I'd appreciate them very much! Thanks

Have a good weekend

gmayor · #8 01-28-2023, 03:14 AM

The following should work.

Code:

Sub ReAttach()
Dim olItem As MailItem
Dim olAtt As Attachment
Dim sName As String
Dim sPath As String
Dim cNames As Collection
Dim i As Long

    sPath = Environ("TEMP") & "\"
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select
    olItem.Save
    Set cNames = New Collection
    If olItem.Attachments.Count > 0 Then
        For i = olItem.Attachments.Count To 1 Step -1
            Set olAtt = olItem.Attachments(i)
            sName = olAtt.FileName
            If Not sName Like "image*.jpg" Then
                sName = Replace(olAtt.FileName, "%20", " ")
                olAtt.SaveAsFile sPath & sName
                cNames.Add sPath & sName
                olAtt.Delete
            End If
        Next i
        For i = 0 To cNames.Count
            'Debug.Print cNames(i)
            olItem.Attachments.Add cNames(i)
            Kill cNames(i)
        Next i
    End If
lbl_Exit:
    Set olItem = Nothing
    Set olAtt = Nothing
    Set cNames = Nothing
    Exit Sub
End Sub

JamesMWood · #9 01-29-2023, 04:37 PM

You're an absolute genius. Thank you so, so much. This has been driving me mad, and I really am trying to learn. Thanks a lot!

JamesMWood · #10 01-30-2023, 03:10 AM

If you were replying to an email and there were signature images in there, is there any way this could ignore those? For instance, I've just ran the macro while replying to an email, but it then also attachs the image files from signatures in the email.

gmayor · #11 01-30-2023, 06:02 AM

Normally signature images are in the format "image001.jpg" which the line

Code:

If Not sName Like "image*.jpg" Then

should omit. If your images are in a different format then you can use a similar statement to omit those, or if your attachments are in a particular format e.g. *.docx or *.xlsx then you could change the line to (say)

Code:

If sName Like "*.docx" Or sName Like "*.xlsx" Then

or whatever fits your requirements to process just those attachment formats.

JamesMWood · #12 01-30-2023, 06:53 AM

Quote:

Originally Posted by gmayor

Normally signature images are in the format "image001.jpg" which the line

Code:

If Not sName Like "image*.jpg" Then

should omit. If your images are in a different format then you can use a similar statement to omit those, or if your attachments are in a particular format e.g. *.docx or *.xlsx then you could change the line to (say)

Code:

If sName Like "*.docx" Or sName Like "*.xlsx" Then

or whatever fits your requirements to process just those attachment formats.

Ahhh I understand, I'll give that a shot. Thanks very much, you are really generous with your time and knowledge, it's appreciated.

JamesMWood · #13 01-30-2023, 07:52 AM

If I add multiple filename extensions with Or, it only seems to pick up on the first one. Any idea what might be wrong? e.g.

If Not sName Like "image*.jpg" Or sName Like "image*.png" Then

only jpg gets picked up on

JamesMWood · #14 01-31-2023, 03:51 AM

Not sure if it's because I'm doing this in Visual Studio - maybe the coding is slightly different for multiple 'Or' statements?

JamesMWood · #15 02-01-2023, 04:09 AM

So, I found a way around it. All of our attachments are usually PDF, so instead of 'Not' I changed it to:

If sName Like "*.pdf" Then

So it only picks up on the PDFs and ignores everything else

However... I'm still not sure why the multiple condition for Or didn't work??

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Rename attachment based on attachment name	AndyDDUK	Outlook	1	03-01-2017 07:32 AM
Rename attachment based on attachment name	AndyDDUK	Outlook	1	03-01-2017 07:31 AM
Rename docm to value from checkbox, convert to .pdf, email, delete	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
email as pdf attachment - subject line and attachment named after mail merge	Nexus	Mail Merge	12	04-13-2011 11:34 PM