Save files attached to an email

[Steve]

How do you programatically save files that are attached to an email to a
specified folder? It could be one file or multiple files attached to the email.
Can it be done if Outlook Express is being used or does Outlook have to be used?

Thanks for all help!

Steve

 

[Mark Phillipson]

Hi,

I don't now about Outlook Express, but to do it in Outlook adapt the
following function:

Public Function SaveAttachedFiles(strSubject as String) As Boolean
Dim olookApp As Outlook.Application
Dim objAttachments As Outlook.Attachments
Dim Attachment As Outlook.Attachment
Dim myNameSpace As NameSpace
Dim myfolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim strFile As String, strSaved As String
SaveAttachedFiles = False
' create the Outlook session.
Set olookApp = CreateObject("Outlook.Application")
Set myNameSpace = olookApp.GetNamespace("MAPI")
'Get the default Inbox
Set myfolder = _
myNameSpace.GetDefaultFolder(olFolderInbox)
For Each myItem In myfolder.Items
If myItem.Subject = strSubject And myItem.UnRead Then
With myItem
Set objAttachments = myItem.Attachments
For Each Attachment In objAttachments
strFile = "C:\Saved Files\" & Attachment.DisplayName
Attachment.SaveAsFile (strFile)
strSaved = "Saved to " & strFile & " on " & Now()
Next
If Len(Trim(strSaved)) > 0 Then
myItem.Body = strSaved & vbCrLf & vbCrLf & myItem.Body
.Save
End If
.UnRead = False
SaveAttachedFiles= True
Exit For
End With

End If
Next
Set olookApp = Nothing

End Function

HTH

--

Cheers
Mark

Free Access/Office Add-Ins at:
http://mphillipson.users.btopenworld.com/

 

[Roberto Spier]

How do you programatically save files that are attached to an email to a
specified folder? It could be one file or multiple files attached to the email.
Can it be done if Outlook Express is being used or does Outlook have to be used?

Thanks for all help!

Steve

Hi Steve,

this (uggly, perhaps) code loops thru the OE Inbox folder and, as it
displays the attached filenames, saved in a temp OE folder. These files can
be copied/saved everywhere.

'************ Begin of code
' notice line wrap

Option Compare Database
Option Explicit

'With Acc97, need to call VBAMAP32.DLL instead of calling MAPI32.DLL
'directly.
'
'***************************************************
' MAPI Message holds information about a message
'***************************************************
Type MapiMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type

'************************************************
' MAPIRecip holds information about a message
' originator or recipient
'************************************************
Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type

'******************************************************
' MapiFile holds information about file attachments
'******************************************************
Type MAPIfile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type

'***************************
' FUNCTION Declarations
'***************************
Declare Function MAPILogon Lib "VBAMAP32.DLL" Alias "BMAPILogon"
(ByVal UIParam&, ByVal user$, ByVal Password$, ByVal Flags&, ByVal
Reserved&, Session&) As Long
Declare Function MAPILogoff Lib "VBAMAP32.DLL" Alias "BMAPILogoff"
(ByVal Session&, ByVal UIParam&, ByVal Flags&, ByVal Reserved&) As
Long
Declare Function MAPIFindNext Lib "VBAMAP32.DLL" Alias "BMAPIFindNext"
(ByVal Session&, ByVal UIParam&, ByVal MsgType$, ByVal SeedMsgID$,
ByVal flag&, ByVal Reserved&, MsgID$) As Long
Declare Function MAPIReadMail Lib "VBAMAP32.DLL" Alias "BMAPIReadMail"
(ByVal Session&, ByVal UIParam&, ByVal MsgID$, ByVal Flags&, ByVal
Reserved&, Message As MapiMessage, Originator As MapiRecip, Recips()
As MapiRecip, files() As MAPIfile) As Long

'**************************
' CONSTANT Declarations
'**************************
'
Global Const MAPI_SUCCESS = 0

Global Const MAPI_UNREAD = 1
Global Const MAPI_RECEIPT_REQUESTED = 2
Global Const MAPI_SENT = 4

'***********************
' FLAG Declarations
'***********************
Global Const MAPI_LOGON_UI = &H1
Global Const MAPI_NEW_SESSION = &H2
Global Const MAPI_DIALOG = &H8
Global Const MAPI_UNREAD_ONLY = &H20
Global Const MAPI_ENVELOPE_ONLY = &H40
Global Const MAPI_PEEK = &H80
Global Const MAPI_GUARANTEE_FIFO = &H100
Global Const MAPI_BODY_AS_FILE = &H200
Global Const MAPI_AB_NOMODIFY = &H400
Global Const MAPI_SUPPRESS_ATTACH = &H800
Global Const MAPI_FORCE_DOWNLOAD = &H1000


Public Function get_email()
Dim Session&, rc&
Dim MessageID As String * 512
Dim Msg As MapiMessage
Dim Originator As MapiRecip
Dim aRecips() As MapiRecip
Dim aFiles() As MAPIfile
Dim strFileName As String
Dim Hwnd As Long
Dim i As Integer

DoCmd.Hourglass True
'Hwnd = Forms![principal].Hwnd
rc& = MAPILogon(Hwnd, vbNullString, vbNullString, _
MAPI_FORCE_DOWNLOAD, 0&, Session&)
rc& = MAPILogoff(Session&, Hwnd, 0&, 0&)

If rc& = MAPI_SUCCESS Then
rc& = MAPILogon(0&, vbNullString, vbNullString, 0&, 0&,
Session&)
rc& = MAPIFindNext(Session&, 0&, vbNullString, vbNullString, _
MAPI_GUARANTEE_FIFO, 0&, MessageID)

Do While rc& = MAPI_SUCCESS
rc& = MAPIReadMail(Session&, 0&, MessageID$, _
MAPI_ENVELOPE_ONLY, _
0&, Msg, Originator, aRecips(), aFiles())
If rc& = MAPI_SUCCESS Then

' If Msg.Subject = "Subject i'm waiting for!" Then

rc& = MAPIReadMail(Session&, 0&, MessageID$, 0&, _
0&, Msg, Originator, aRecips(), aFiles())

' this are working since OE 5 through OE 6
Debug.Print CVDate(Msg.DateReceived)

If Msg.FileCount <> 0 Then

Debug.Print UBound(aFiles()) + 1 & " attached files"

' now, the attached files
For i = 0 To Msg.FileCount - 1

strFileName = StrConv(aFiles(i).FileName,
vbUnicode)

'Here the attached files are actually saved in a
temp folder
Debug.Print "Attached file saved: " &
strFileName

Next
End If
' End If
End If

rc& = MAPIFindNext(Session&, 0&, vbNullString, MessageID$, _
0&, 0&, MessageID)
Loop

rc& = MAPILogoff(Session&, 0&, 0&, 0&)
End If
get_email = rc&
DoCmd.Hourglass False
End Function
'************ end of code

Roberto