Extracting Attachments from Outlook Email

Photomofo

Board Regular
Joined
Aug 20, 2012
Messages
240
Good Evening,

I'm trying to avoid the use of On Error Resume Next. I've never used it until recently when I started building a program that explores new territory for me. Specifically, Send Keys, accessing data from the Clipboard and interrogating Outlook. I've noticed that once you drink the On Error Resume Next tea you end up with all sorts of unintended consequences. So... I'm trying to fix my program so I don't get any errors.

I'm getting an error when I try to grab the File_Name of an attachment. It's saying the attachment has been moved or deleted.

This is the step it's hanging up on. Is there a way to test if an attachment exists? Sorta like If DIR(Path) <> "" then. I couldn't find anything on Google.

VBA Code:
File_Name = Email.Attachments.Item(1).Filename

Note also I'm using a for I = 1 to 10 loop. This is because this code doesn't loop through the emails properly. I have no idea why if you have any advice I'd appreciate it.

Here's the entire code.

Code:
'The starting structure of this sub was borrowed from: https://stackoverflow.com/questions/45346183/excel-vba-looping-through-all-subfolders-in-outlook-email-to-find-an-email-with

Sub Get_Attachment()

Dim i As Integer
Dim j As Integer
Dim ARG As String
Dim Destination As String
Dim File_Name As String
Dim File_Type As String
Dim Time_Sent As String

Dim Email As Outlook.MailItem
Dim Inbox As Outlook.Items
Dim OutApp As Outlook.Application
Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Namespace As Outlook.Namespace

Set OutApp = New Outlook.Application
Set Namespace = OutApp.GetNamespace("MAPI")
'On Error Resume Next

'Grabvdata Drive locations
Destination = "C:ABC"

For i = 1 To 10

For Each Folder In Namespace.Folders

If Folder = "ABC" Then

For Each SubFolder In Folder.Folders

If SubFolder = "Inbox" Then

Set Inbox = SubFolder.Items

For Each Email In Inbox

'check for attachments
If Email.Attachments.Count > 0 Then

'loop through all attachments
For j = 1 To Email.Attachments.Count

File_Name = Email.Attachments.Item(1).Filename
Time_Sent = Get_Time_Stamp(Email.SentOn)

'Narrow search to csv attachments
Select Case "csv"

Case "csv"

ARG = Replace(File_Name, ".csv", "", 1)

If ARG = "ABC" Then

If Dir(Destination & "ABC\" & ARG & " - " & Time_Sent & ".csv") = "" Then

ARG = "ABC\" & "ABC" & " - " & Time_Sent & ".csv"
Email.Attachments.Item(j).SaveAsFile Destination & ARG

End If

ElseIf ARG = "ABC" Then

If Dir(Destination & "ABC\" & ARG & " - " & Time_Sent & ".csv") = "" Then

ARG = "ABC\" & "ABC" & " - " & Time_Sent & ".csv"
Email.Attachments.Item(j).SaveAsFile Destination & ARG

End If

ElseIf ARG = "ABC" Then

If Dir(Destination & "ABC\" & ARG & " - " & Time_Sent & ".csv") = "" Then

ARG = "ABC\" & "ABC" & " - " & Time_Sent & ".csv"
Email.Attachments.Item(j).SaveAsFile Destination & ARG
ARG = "ABC" & " - " & Time_Sent & ".csv"
Call Library.This_to_That(ARG)

End If

End If

Email.Delete

End Select

Next

End If

Next Email

End If

Next SubFolder

End If

Next Folder

Next i

End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Watch MrExcel Video

Forum statistics

Threads
1,130,309
Messages
5,641,448
Members
417,209
Latest member
Agbarker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top