Solved

how to extract files from outlook 2013 with vba on access

Posted on 2014-12-08
3
255 Views
Last Modified: 2014-12-17
hi


i have this code to loop on microsoft access 2013 form that loop all emails on outlook. what i have to add to the  code to check every email if it's have any attachment file and if so to extract it.

this is the code
Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oInbox As Outlook.MAPIFolder
Dim oMailItem As Outlook.MailItem

Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oInbox = oNS.GetDefaultFolder(olFolderInbox)

For Each oMailItem In oInbox.Items
    MsgBox oMailItem.Attachments
Next

Open in new window

0
Comment
Question by:bill201
3 Comments
 
LVL 24

Expert Comment

by:Phillip Burton
Comment Utility
You would do a look on oMailItem.Attachments() and, use .SaveAsFile(strDirectoryAndFileName)
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 500 total points
Comment Utility
Given that Outlook only wants one instance open, fire it up with the following code.
The rest should get you very close to what you need

Option Explicit
Option Compare Database

Public Function FireOutlook() As Outlook.Application
On Error Resume Next
Dim objOutlook As Outlook.Application

Set objOutlook = GetObject(, "Outlook.Application")
'MsgBox Err.Number & " " & Err.Description
If Err.Number = 429 Then
    Err.Clear
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")
End If

Set FireOutlook = objOutlook

End Function


Sub GetAttachments()
Dim OutlookApp As Outlook.Application
Dim oNameSpace    As Namespace
Dim oFldrList     As Outlook.MAPIFolder

Dim ThePath As String
Dim ns As Namespace
Dim Item As Object
Dim olItem As MailItem
Dim olAtt As Outlook.Attachment
Set OutlookApp = FireOutlook
Dim i As Integer
i = 0
ThePath = "c:\temp\" 'change this to suit you
Set oNameSpace = OutlookApp.GetNamespace("MAPI")
Set oFldrList = oNameSpace.GetDefaultFolder(olFolderInbox)

For Each olItem In oFldrList.Items
    For Each olAtt In olItem.Attachments
       olAtt.SaveAsFile ThePath& olAtt.FileName
       i = i + 1
    Next
Next

If i > 0 Then
   MsgBox "I found " & i & " attached files." _
      & vbCrLf & "I have saved them on the" & ThePath & " Path." _
      & vbCrLf & vbCrLf & " ", vbInformation, "Download Finished!"
Else
   MsgBox "I didn't find any attached files in your mail.", vbInformation, _
   "Finished!"
End If

End Sub

Open in new window

0
 

Author Closing Comment

by:bill201
Comment Utility
thanks alot
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Entering time in Microsoft Access can be difficult. An input mask often bothers users more than helping them and won't catch all typing errors. This article shows how to create a textbox for 24-hour time input with full validation politely catching …
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now