Edit (June 29,2017): I have made a couple minor changes to the code. One resolves the issue with to-be-renamed attachments being removed from the well when you don’t rename all attachments. The other may resolve the issue with the “path does not exist” error that some have gotten. I can’t be sure because I am unable to reproduce the error.
I often send PowerShell scripts via email. But because .ps1 is a Level 1 attachment, the recipient, if using Outlook, won’t be able to access it (by default). This means I need to rename the file before attaching it to the message. I don’t like doing that, however, because then I have to rename it back after attaching it. I can also compress (zip) the file or make a copy and rename that, but I still have extra files that I then have to delete. I would much rather deal with the file in the context I am sending it: Outlook.
I wrote a VBA macro several years ago that allows me to rename attachments after adding them to the message. Recently, I had an opportunity to share it with somebody so I took the time to update it to accommodate additional scenarios. For example, I discovered that when replying/forwarding a message that has inline images, those are included in the attachment collection, so I had to find a way to exclude those. The same is true when an embedded message is attached. Since the macro was being shared with others, I also added some additional error detection logic to deal with scenarios that normally wouldn’t apply to me or I could deal with one-off.
To use the macro, paste it into ThisOutlookSession in the VBA editor and save it. I modified the ribbon of the new message form (just using the built-in ribbon designer) to add a button that I labeled Rename Attachments and used one of the available icons (there aren’t a lot to choose from), clicking the button runs the macro. (You have to change the default macro security settings in the Trust Center because it isn’t digitally signed.)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 |
Sub RenameAttachmentsWithPrompt() Dim olkItem As Outlook.MailItem Dim olkAttachment As Outlook.Attachment, olkAttachments As Outlook.Attachments Dim objFSO As Object, strFolder As String, strFilename As String Dim olkPA As PropertyAccessor Dim arrRenamedAttachments() As String Dim bValidAttachment, bRenamedAttachment As Boolean If Application.ActiveInspector Is Nothing Then Set olkItem = Application.ActiveExplorer.Selection.Item(1) Else Set olkItem = Application.ActiveInspector.CurrentItem End If i = 1 bValidAttachment = False If olkItem.Attachments.Count > 0 Then If MsgBox("Do you want to rename any of the attachments?", vbYesNo, "Rename any attachments?") = vbYes Then Set olkAttachments = olkItem.Attachments Set objFSO = CreateObject("Scripting.FileSystemObject") 'Bind to the system temp folder strFolder = objFSO.GetSpecialFolder(2) 'Loop through attachments in reverse to account for 'collection size changing when deleting an attachment For j = olkAttachments.Count To 1 Step -1 Set olkAttachment = olkAttachments.Item(j) Set olkPA = olkAttachment.PropertyAccessor Dim bHidden As Boolean 'Visible attachments usually don't have hidden property set so ignore error On Error Resume Next bHidden = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x7FFE000B") On Error GoTo 0 'Skip embedded messages and hidden attachments If olkAttachment.Type <> olEmbeddeditem And (Not bHidden Or IsNull(bHidden)) Then bValidAttachment = True strFilename = "" strFilename = InputBox("What do you want to name the attachment?" & _ vbNewLine & vbNewLine & "(To leave it as is, click OK or Cancel.)", _ "Rename Attachment", olkAttachment.FileName) If strFilename <> olkAttachment.FileName And strFilename <> "" Then 'Attachment file names are read-only, so save renamed attachment to disk 'and delete original from message ReDim Preserve arrRenamedAttachments(i - 1) olkAttachment.SaveAsFile strFolder & "\" & strFilename olkAttachment.Delete arrRenamedAttachments(i - 1) = strFolder & "\" & strFilename bRenamedAttachment = True i = i + 1 End If End If Next If Not bValidAttachment Then noValid = MsgBox("There are no attachments that can be renamed." & vbNewLine & vbNewLine & _ "(Only embedded messages or hidden attachments are in the message.)", vbOKOnly) End If 'Add renamed attachment(s) to message and delete from temp folder If bRenamedAttachment Then For Each strFilePath In arrRenamedAttachments olkItem.Attachments.Add strFilePath objFSO.DeleteFile strFilePath Next End If End If Else noAttach = MsgBox("There are no attachments in the message.", vbOKOnly) End If Set olkItem = Nothing Set olkAttachment = Nothing Set olkPA = Nothing Set objFSO = Nothing End Sub |
Thank you. This works. The only issue is that it gives me an error message because it can’t seem to find my “Attachments” folder in my Documents directory.
Microsoft Visual Basic
Run-time error ‘-2147024893 (80070003)’:
Path does not exist. Verify the path is correct.
I have unchecked “read only” box on the folder and tried again, only to get the same error message.
But other than that, it DOES change the name within the active new mail window.
Are you referring to the temporary folder where the attachments are saved when being renamed? It uses whatever the path is for the TMP system variable.
I am getting the same error and when you click on debug it selects
olkItem.Attachments.Add strFilePath
Hello Scott, I am a complete newbie on VBA and face the same problem as POL. Unfortunetly I could not fix the path-problem. I don’t seem to understand how and where I have to change the reference in the code, in order to take the right reference.
Thanks in advance!
The line\AppData\Local\Temp. If a path is returned, then make sure the user has permission to that directory. If you want to bypass using the defined temp folder, you can always hard-code a path. Change the line to be
strFolder = objFSO.GetSpecialFolder(2)
is where the path is selected. 2 is the argument for the system temp folder as defined by TMP in the user/system variables. To verify that it is defined, you can go to a command prompt and run “echo %tmp%” to see what path is returned. For me, it is C:\Users\strFolder = objFSO.GetFolder("c:\folder\anotherfolder")
.I am getting the same error message as POL and others. I have verified that TMP is defined by going to the command prompt and running “echo %tmp%” and I have full permissions for that directory. For some reason I am still getting the error.
Then I changed the line to hardcode the path [strFolder = objFSO.GetFolder(“C:\Users\\AppData\Local\Temp”)]
and still got the error message.
Finally, I created a new folder, hardcoded the path to the new folder, and still got the error message.
In each of the above scenarios, the filename of the attachment was successfully renamed. The error message is simply an annoyance but if we could figure out how to fix it, that would be awesome. As it is, the script function is amazing and has saved me countless save/rename/reattach procedures.
Thank you!
DB, I have never gotten the error and have used the macro on multiple systems and OSes. I will have to do further testing to see if I can find the scenario in which it is happening. What I didn’t realize, until you mentioned it, is that the attachment is successfully renamed. (Looking at the comments thread, I see it was already mentioned, but I must have forgotten.) I have a few ideas why the error might be occurring, but it will be difficult to test if I can’t make it happen myself.
this is great code Scott. Thank you so much for sharing.
Could you modify it so it counts the number of attachments only located at the attachments’ field and not count hidden attachments or embedded images ?
I should like to thank you in advance for your help.
panos
The macro already skips hidden attachments and embedded images. Because it has been a while since I last made any code changes to the macro, I just tested it by adding two inline images to a messages and a Word document to the attachment well. When I ran the macro, it only prompted me to rename the Word document.