Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

how to extract files from outlook 2013 with vba on access

Posted on 2014-12-08
3
Medium Priority
?
290 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
ID: 40486455
You would do a look on oMailItem.Attachments() and, use .SaveAsFile(strDirectoryAndFileName)
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 2000 total points
ID: 40487204
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
ID: 40505904
thanks alot
0

Featured Post

 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Explore the ways to Unlock VBA Project Password Excel 2010 & 2013 documents. Go through the article and perform the steps carefully to remove VBA Excel .xls file.
In this post, I will showcase the steps for how to create groups in Office 365. Office 365 groups allow for ease of flexibility and collaboration between staff members.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

926 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