download email attachments based on the subject line and folder names from a worksht

If this is your first visit, be sure to
check out the FAQ by clicking the
link above. You may have to register
before you can post: click the register link above to proceed. To start viewing messages,
select the forum that you want to visit from the selection below.

download email attachments based on the subject line and folder names from a worksht

I got a list of email attachements which i need to download from different folders of outlook in a excel sheet in the below order.

data is in range Row 2 to 10 but can be more in future
Column A: File / attachment name
Column B: Email Subject Line
Column C: Outlook Folder Name
Column D: Save as location for attachements (different for each)

Now I have below function which I got through google search which I want to use, below is what i have put together so far, also I want to add the subject line and filename as string (since I want to name the attachment as its mentioned in the worksheet while saving) which is missing in the function:

Re: download email attachments based on the subject line and folder names from a work

from the code it appears it should save all .xls attachments, but does not in anyway use the attachment file name in column A

depending on the number of emails in outlook folders there may be much better ways than looping all the folder items, you can use the items.restrict method, to limit the number of items to match the subject line

Code:

set sitems = subfolder.items.restrict("[subject]='" & subj & "'")
For Each Item In sitems
For Each Atmt In Item.Attachments
If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
FileName = DestFolder & Atmt.FileName
Atmt.SaveAsFile FileName
I = I + 1
End If
Next Atmt
Next Item

where subj is an additional parameter to the function, from the calling procedure

ActiveCell.Offset(1, 0).Select

there is no need for this line
also it would be better not to create an instance of outlook for every line in the worksheet, better to just have one instance and use the for all iterations
i believe i would just integrate the function in to the main procedure, though you could open an outlook instance in the main procedure, then pass the outlook subfolder to the function

Last edited by westconn1; Feb 9th, 2018 at 05:50 AM.

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

Re: download email attachments based on the subject line and folder names from a work

ok. I have made the below changes, but where do i capture the Outlook folder name since its not just one outlook folder we need to loop through different outlook folder and download the attachments and rather than looping through every folder, it's better to look into the folders which are listed in the column C, also how can we make sure that we download only the most recent date attachements from the folders since the mails with same subject are received daily.

Re: download email attachments based on the subject line and folder names from a work

i made some changes to your procedure, i also noted that you do not have an outlook application object, so possibly some of the original code was written in outlook, for the outlook variables to be valid would require a reference to outlook, else change the variables to object, i have not tested the code as posted, so may contain some typo or code error, i fixed or changed anything i noticed that did not look right,

Code:

Sub Downloademailattachments()
Dim x As Integer
Dim OutlookfolderInInbox As String
Dim Subjectline As String
Dim DestFolder As String
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim MyDocPath As String
Dim I As Integer
Dim wsh As Object
Dim fs As Object
Set olook = CreateObject("outlook.application")
Set ns = olook.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
' if you want to start at row 2, change to for x = 2 to numrows
For x = 1 To NumRows
Subjectline = ThisWorkbook.Sheets("Sheet1").Range(Cells(x, 2)).Value
OutlookfolderInInbox = ThisWorkbook.Sheets("Sheet1").Range(Cells(x, 3)).Value
DestFolder = ThisWorkbook.Sheets("Sheet1").Range(Cells(x, 4)).Value
ExtString = ".xls"
Set SubFolder = Inbox.Folders(OutlookfolderInInbox)
Set sitems = SubFolder.Items.restrict("[subject]='" & Subjectline & "'")
For Each Item In sitems
For Each Atmt In Item.Attachments
If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
FileName = DestFolder & Atmt.FileName
'if destfolder does not have a trailing \ then one would need to be appended to the path
Atmt.SaveAsFile FileName
I = I + 1
End If
Next Atmt
Next Item
Next x
Set Inbox = Nothing
Set ns = Nothing
' olook.quit 'if required
Set olook = Nothing
End Sub

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

Re: download email attachments based on the subject line and folder names from a work

Ok. i had to make a small tweak and it works now, the only thing is that if i have to download the files with multiple extensions at one go then how do i add the same to the code. for e.g. i have *.csv, *.xls, *.txt and *.xml this four extension file type attachments are expected then how can we include the same.

Re: download email attachments based on the subject line and folder names from a work

change attachment loop like

Code:

For Each Atmt In Item.Attachments
select case LCase(Right(Atmt.FileName, instr(atmt.filename, ".")))
case ".xls", ".csv", ".pdf", ".xlsx"
FileName = DestFolder & Atmt.FileName
'if destfolder does not have a trailing \ then one would need to be appended to the path
Atmt.SaveAsFile FileName
I = I + 1
End select
Next Atmt

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

Re: download email attachments based on the subject line and folder names from a work

Ok. I have replaced the above piece of code but now it doesn't working and doesn't show any error msg as well. I checked if the destination folder is ending with "\" and it is ending with "\" and everything else is same but it's not working, apart from this i have also tried to declare the extn case as string because i don't want to hardcode the extensions but it didn't work so i have commented it out for now.

Re: download email attachments based on the subject line and folder names from a work

i screwed up the right statement,
decided mid is better anyway

this only partial code to show the changes

Code:

extstring = ".xlsx, .csv, .txt," 'include other extensions .i.e. *.csv, *.xml, *.txt or get from some cell
Set SubFolder = Inbox.Folders(OutlookfolderInInbox)
Set sitems = SubFolder.Items.Restrict("[subject]='" & Subjectline & "'")
For Each Item In sitems
For Each atmt In Item.Attachments
fext = Mid(atmt.FileName, InStrRev(atmt.FileName, "."))
Select Case True
Case InStr(extstring, fext & ",")
FileName = DestFolder & atmt.FileName
atmt.SaveAsFile FileName
i = i + 1 ' i am not sure what the counter is used for
End Select
Next atmt
Next Item

i changed the select case to use variable, this should now allow a multiple filetype string, needs to have a comma or someother separator character, immediately after each fileextn (including the last)

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

Email subject line 2: Outstanding Dues (this mail subject line doesn't have the date so in this case its the same every day and if i expect this mail 10am everyday then i will go ahead and run it at 10.05am everyday so if the mail has not yet arrived then it will download previous day mail attachment.

To tackle this issue, i am planning to include a column called Mail Date (Column E) and formulate it with expected date .i.e. if its yesterday COB then today minus 1 and it comes in 2 days then today -2 will take workday to avoid weekend's, so how can we refer the macro to this mail date column

and i want to include also a column at the end (Column F) as Download Status, if the file gets downloaded then it will get populated with the text "File Downloaded Successfully" and if not then it will get populated with the text "Email not found". for error, i was trying to include the below errhandler but believe i am not adding it in the right place, hence its not working. can you advise.

Re: download email attachments based on the subject line and folder names from a work

you could use some flag to indicate if the mail has already been processed
also message properties have a sentdate you could possibly make use of

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

Re: download email attachments based on the subject line and folder names from a work

If item.receivedtime = MailDate then

looks like you need an end if somewhere, after next atmt?

errhandler will run every time regardless of whether there is an error, so all rows will show email not found

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete

this should work ok for any error saving the attachments, and allows the code to continue for next rows, but does nothing for other parts of the code so i moved the on error forward to encompass finding the outlook folder as well, some separate error handler may be good for the setting the outlook objects as without them nothing will work

i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

dim all variablesas required as often i have done so elsewhere in my code but only posted the relevant part

come back and mark your original post as resolved if your problem is fixed
pete