VBA script to auto download attachments and rename file according to subject line

Status
Not open for further replies.

dvlkn

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
Hi everyone

First time poster here. I am trying to edit this script to automatically download attachment(s) from certain emails (based on rules) and rename the attachment to what is in the subject line. The subject line typically says:
"Ticket # 1111111111 Order # 999999999" and I would like to return to only the "1111111111". The file type is usually .pdf if that matters.
By looking around, I only have the following code that will download the attachment and save it as it is.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "path here"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub

This is what I have so far but it is not working obviously:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim Subject As String
Dim Ticket As String
saveFolder = "path here"
For Each objAtt In itm.Attachments
Subject = itm.Subject
If InStr(1, Subject, "#") > 0 Then
'Trim beginning of subject
Subject = Mid(Subject, InStr(Subject, "#") + 1)
'Trim ending of subject
If InStr(Subject, " ") > 0 Then
Ticket = Left(Subject, InStr(Subject, " Order") - 1)
End If
End If
objAtt.SaveAsFile saveFolder & "\" & Invoice
Set objAtt = Nothing
Next
End Sub
 
Thank you for your reply. I am not sure which part does not work. When I run the rule which runs the script, it says something like "Cannot save the file to folder xyz". Not having put the extension might be what is preventing it from saving the file. I will give your suggestion a try as soon as I get home! Thanks for your help!
 
The folder you are saving to needs to exist. Also, don't forget to put the path in this line -
saveFolder = "path here"
 
Yes i did put the path, I just omitted it in this post to simplify. Sorry about that.
So I added the extension and it looks like it is running. However when I ran it on 5 emails, it resulted in only one PDF (there is one attachment per email) being saved without a name. So I am guessing my "parsing" for the ticket # is incorrect and it just overwrites itself continuously resulting in only one file with no name.
Is mid() and instr() the functions that I should use or is there a better way?
 
Yes i did put the path, I just omitted it in this post to simplify. Sorry about that.
I assumed that is what you did, but wanted to double check.

I don't think the parsing is wrong, but that the macro isn't getting a new item or clearing the old item. You could try using Subject = "" before setting it and/or try setting itm = nothing at the end.

You can add debug.print subject and debug.print ticket to see if its using the right values. You can do the same for the instr fnctions to see if the expected values are correct. They'll be show in the immediate window - Ctrl+G to open.

Actually, you don't need to check the subject for blanks do you? Remove that if/end if pair.

Code:
 If itm.Attachments.Count > 0 Then 
     Subject = itm.Subject 
For Each objAtt In itm.Attachments 
If InStr(1, Subject, "#") > 0 Then 
      'Trim beginning of subject 
    Subject = Mid(Subject, InStr(Subject, "#") + 1) 
     'Trim ending of subject 
    Ticket = Left(Subject, InStr(Subject, " Order") - 1) 
End If 
    objAtt.SaveAsFile saveFolder & "\" & Ticket & ".pdf" 
Next 
Set objAtt = Nothing 
Set itm = Nothing
 
It shouldn't make a difference, but you can also do all the subject/ticket stuff together then get the attachment

Code:
 If itm.Attachments.Count > 0 Then 
     Subject = itm.Subject 
 
If InStr(1, Subject, "#") > 0 Then 
      'Trim beginning of subject 
    Subject = Mid(Subject, InStr(Subject, "#") + 1) 
     'Trim ending of subject 
    If InStr(Subject, " ") > 0 Then 
        Ticket = Left(Subject, InStr(Subject, " Order") - 1) 
     End If 
End If 
For Each objAtt In itm.Attachments 
    objAtt.SaveAsFile saveFolder & "\" & Ticket & ".pdf" 
Next

And hope you only have 1 attachment. :)
 
Thank you for your help! I was able to fix my code shortly after I posted. Like you said, I do not need the script to check for subject for blanks after all. I can even omit the check for attachment since the "rule" that I run already pick up emails that has one ;)
The completed code for the sake of sharing:

Code:
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
Dim Subject As String 
Dim Ticket As String 
 
saveFolder = "C:\Test" 
     For Each objAtt In itm.Attachments 
Subject = itm.Subject 
 
'Trim beginning of subject 
Subject = Mid(Subject, InStr(Subject, "#") + 1) 
 
'Trim ending of subject 
Ticket = Left(Subject, InStr(Subject, " Order") - 1) 
 
objAtt.SaveAsFile saveFolder & "\" & Ticket & ".pdf" 
 
Set objAtt = Nothing 
Next 
 
End Sub
 
So the blanks code was causing all the problems? I never would have guessed.
 
Hi Diane! Maybe you can help me out again. I am now receiving attachments but with nothing relevant in the subject line. The attachment name itself contains the ticket number that I need. So I figure I would have to re-direct the script to the attachment name itself and trim the excess information before it saves to folder. Can you tell me how do I go about doing that? And would it work if there are more than one attachment this time?

Looking through the "code dictionnary" I found attachment.Filename, is that something I should be using?

In short, I have an attachment that comes in as Ticket # 11111 Order # 12345 and I would like it to return to only 11111.
 
Yes, use objAtt.filename - you'll strip it the same way - might be able to use the code above and change just one line:

saveFolder = "C:\Test"
For Each objAtt In itm.Attachments
Subject = objAtt.filename
 
Hi Diane!

Sorry to hijack this post but my problem is related to the solution that is kindly provided by Diane!
The code works in my situation! But an error message pops up when I try to open the file:/

The file I receive is an ".xlsx" format file and like dvlkn, I required to extract the unique identifier in the email and rename the file.

"Excel cannot open the file 'Jul-09.xlsx' because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file." *see picture

I tried to save it as '.xls' format instead, and the file manages to open but the contents are all corrupted.

Any clue what's going on?

(Btw, I administered this code to a few different types of emails I receive and all work well except this particular one)

Thank you for your help!
 

Attachments

  • Untitled.png
    Untitled.png
    8.5 KB · Views: 794
Can you open the original file ok if you save it to the hard drive? The error means the extension does not match the file type so either the code is wrong or the attachment is corrupted.
 
Can you open the original file ok if you save it to the hard drive? The error means the extension does not match the file type so either the code is wrong or the attachment is corrupted.


Yup the original attachment opens up just fine...
its really odd:(

The file is not a protected/encrypted file either.
 
Hello,
I've modified the code to work with multiple attachments (files are saved as 1111111111(1).pdf , 1111111111(2).pdf etc ). Is it possible to modify the code in such a way so that numeration is only applied if there is more than 1 attachment.

Code:
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim Subject As String
Dim Ticket As String
saveFolder = "C:\Test"
     For Each objAtt In itm.Attachments
Subject = itm.Subject
'Trim beginning of subject
Subject = Mid(Subject, InStr(Subject, "#") + 1)
'Trim ending of subject
Ticket = Left(Subject, InStr(Subject, " Order") - 1)
objAtt.SaveAsFile saveFolder & "\" & Ticket & ".pdf"
Set objAtt = Nothing
Next
End Sub

Many thanks!!
 
Call the part that adds the number only if itm.attachments.count>1
Thank for response. I've tried the following but don't seem to get it to work. Can you please check
Code:
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim Subject As String
Dim Ticket As String
Dim i As Integer
saveFolder = "C:\Test"
Subject = itm.Subject

Subject = Mid(Subject, InStr(Subject, "#") + 1)

Ticket = Left(Subject, InStr(Subject, " Order") - 1)

If itm.attachments.count > 1 Then
        
i = 1
For Each objAtt In itm.Attachments
  objAtt.SaveAsFile saveFolder & "\" & Ticket & "(" & CStr(i) & ").pdf"
  i = i + 1
     Else
objAtt.SaveAsFile saveFolder & "\" & Ticket & ".pdf"

Next

End Sub
 
The For-Next block must be before the Else. It looks like this:
Code:
If ... Then
    'condition met
    For....
    Next
Else
    'condition not met
    .....
End If
 
Diane, I've working on this for a couple of days and I need some help. I need to have Outlook sort the attachments based on a key part of the subject line into different folders in my pc. How can I make it happen? Thanks for your help!
 
After you identify the message, you can use a case statement or an array to set the folder.
Select Case True
case instr(1,item.subject,"phrase") >0
saveFolder = "path"

case instr(1,item.subject,"phrase2") >0
saveFolder = "new path"
end select
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
J Outlook Rules VBA Run a Script - Multiple Rules Outlook VBA and Custom Forms 0
A VBA Script - Print Date between first email in Category X and last email in Category Y Outlook VBA and Custom Forms 3
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
D.Moore VBA script fail after Office 365 update Using Outlook 8
S Change VBA script to send HTML email instead of text Outlook VBA and Custom Forms 3
dweller Outlook 2010 Rule Ignores VBA Script Outlook VBA and Custom Forms 2
N VBA Script to Open highlighted e-mail and Edit Message Outlook VBA and Custom Forms 5
K Outlook Archive to PST Files by Date Range VBA Script? Outlook VBA and Custom Forms 1
Peter H Williams Enable script containing VBA Outlook VBA and Custom Forms 12
R VBA Script Quick Parts Using Outlook 1
Q VBA Script to move item in secondary mailbox Outlook VBA and Custom Forms 2
N VBA Script to Send Automatic Emails from Outlook 2010 Outlook VBA and Custom Forms 1
O modify vba to run it as script rule Outlook VBA and Custom Forms 8
P How many subs can run in one outlook VBA script Using Outlook 5
J Email Parsing VBA Script for Outlook - NEEDED Outlook VBA and Custom Forms 7
P Vba script including macro appears in rules but wont run Outlook VBA and Custom Forms 6
R Adding vba to script list Outlook VBA and Custom Forms 4
F VBA script to highlight specific words Outlook VBA and Custom Forms 1
D VBA Script to extract text matching specific criteria Outlook VBA and Custom Forms 1
D VBA Script (Ask to where to save send mail) Outlook VBA and Custom Forms 1
M VBA script to allow mail merges of distribution groups? Using Outlook 7
Hudas Outlook VBA script reverting back to previous changes Outlook VBA and Custom Forms 2
J Outlook 2007 Rules & VBA: How to run a script on a report message (ReportItem) Using Outlook 14
V "Accept + Send the Response now", VBA script? Using Outlook 1
R Addins4Outlook TagIt! addin script or VBA module? Using Outlook 2
S Outlook VBA rule script to process both MailItem and MeetingItem Using Outlook 0
A VBA Script to Forward Spam to AntiSpam Provider Using "Blank" Form Outlook VBA and Custom Forms 2
L Limit VBA Script to one Outlook account Using Outlook 1
H using VBA to edit subject line Outlook VBA and Custom Forms 0
G Get current open draft message body from VBA Outlook VBA and Custom Forms 1
Geldner Problem submitting SPAM using Outlook VBA Form Outlook VBA and Custom Forms 2
P VBA to add email address to Outlook 365 rule Outlook VBA and Custom Forms 0
M Outlook 2016 outlook vba to look into shared mailbox Outlook VBA and Custom Forms 0
V VBA Categories unrelated to visible calendar and Visual appointment Categories Outlook VBA and Custom Forms 2
D Outlook VBA forward the selected email to the original sender’s email ID (including the email used in TO, CC Field) from the email chain Outlook VBA and Custom Forms 2
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
R Outlook 2019 VBA to List Meetings in Rooms Outlook VBA and Custom Forms 0
geoffnoakes Counting and/or listing fired reminders via VBA Using Outlook 1
O VBA - Regex - remove double line spacing Outlook VBA and Custom Forms 1
D.Moore Strange VBA error Outlook VBA and Custom Forms 4
B Modify VBA to create a RULE to block multiple messages Outlook VBA and Custom Forms 0
D Outlook 2021 Using vba code to delete all my spamfolders not only the default one. Outlook VBA and Custom Forms 0
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
D VBA - unable to set rule condition 'on this computer only' Outlook VBA and Custom Forms 5
L Fetch, edit and forward an email with VBA outlook Outlook VBA and Custom Forms 2
BartH VBA no longer working in Outlook Outlook VBA and Custom Forms 1
W Can vba(for outlook) do these 2 things or not? Outlook VBA and Custom Forms 2
MattC Changing the font of an email with VBA Outlook VBA and Custom Forms 1

Similar threads

Back
Top