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
 

dvlkn

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
The folder you are saving to needs to exist. Also, don't forget to put the path in this line -
saveFolder = "path here"
 

dvlkn

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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. :)
 

dvlkn

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
So the blanks code was causing all the problems? I never would have guessed.
 

dvlkn

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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
 

Bench

New Member
Outlook version
Outlook 2010 32 bit
Email Account
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: 650

Forum Admin

Senior Member
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.
 

Bench

New Member
Outlook version
Outlook 2010 32 bit
Email Account
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.
 

ev8383

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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!!
 

ev8383

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
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
 

Frank M

New Member
Outlook version
Outlook 2010 32 bit
Email Account
IMAP
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!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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
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
D VBA code to select a signature from the signatures list Outlook VBA and Custom Forms 3
D Create advanced search (email) via VBA with LONG QUERY (>1024 char) Outlook VBA and Custom Forms 2
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
S vba outlook search string with special characters Outlook VBA and Custom Forms 1
S VBA search string with special characters Outlook VBA and Custom Forms 1
U Outlook 2019 VBA run-time error 424 Outlook VBA and Custom Forms 2
DDB VBA to Auto Insert Date and Time in the signature Outlook VBA and Custom Forms 2
F VBA to move email from Non Default folder to Sub folders as per details given in excel file Outlook VBA and Custom Forms 11
G VBA to save selected Outlook msg with new name in selected network Windows folder Outlook VBA and Custom Forms 1
F Excel VBA to move mails for outlook 365 on secondary mail account Outlook VBA and Custom Forms 1
B Zoom automatically next email item (VBA) Outlook VBA and Custom Forms 2
T vba extract data from msg file as attachment file of mail message Outlook VBA and Custom Forms 1
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
N Save selected messages VBA does not save replies and/or messages that contain : in subject Outlook VBA and Custom Forms 1
Y Filter unread emails in a search folder vba help Outlook VBA and Custom Forms 0
V vBA for searching a cell's contents in Outlook and retrieving the subject line Outlook VBA and Custom Forms 1
B vBA for exporting excel file from outlook 2016 Outlook VBA and Custom Forms 3
K can't get custom form to update multiple contacts using VBA Outlook VBA and Custom Forms 3
S Excel vba code to manage outlook web app Using Outlook 10
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1

Similar threads

Top