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 SaveAttachedFil es(strSubject as String) As Boolean
Dim olookApp As Outlook.Applica tion
Dim objAttachments As Outlook.Attachm ents
Dim Attachment As Outlook.Attachm ent
Dim myNameSpace As NameSpace
Dim myfolder As Outlook.MAPIFol der
Dim myItem As Outlook.MailIte m
Dim strFile As String, strSaved As String
SaveAttachedFil es = False
' create the Outlook session.
Set olookApp = CreateObject("O utlook.Applicat ion")
Set myNameSpace = olookApp.GetNam espace("MAPI")
'Get the default Inbox
Set myfolder = _
myNameSpace.Get DefaultFolder(o lFolderInbox)
For Each myItem In myfolder.Items
If myItem.Subject = strSubject And myItem.UnRead Then
With myItem
Set objAttachments = myItem.Attachme nts
For Each Attachment In objAttachments
strFile = "C:\Saved Files\" & Attachment.Disp layName
Attachment.Save AsFile (strFile)
strSaved = "Saved to " & strFile & " on " & Now()
Next
If Len(Trim(strSav ed)) > 0 Then
myItem.Body = strSaved & vbCrLf & vbCrLf & myItem.Body
.Save
End If
.UnRead = False
SaveAttachedFil es= 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/

"Steve" <sp**@nospam.co m> wrote in message
news:MT******** *****@newsread2 .news.atl.earth link.net...

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

[Roberto Spier]

"Steve" <sp**@nospam.co m> escreveu na mensagem
news:MT******** *****@newsread2 .news.atl.earth link.net...

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.D LL" Alias "BMAPILogon "
(ByVal UIParam&, ByVal user$, ByVal Password$, ByVal Flags&, ByVal
Reserved&, Session&) As Long
Declare Function MAPILogoff Lib "VBAMAP32.D LL" Alias "BMAPILogof f"
(ByVal Session&, ByVal UIParam&, ByVal Flags&, ByVal Reserved&) As
Long
Declare Function MAPIFindNext Lib "VBAMAP32.D LL" Alias "BMAPIFindN ext"
(ByVal Session&, ByVal UIParam&, ByVal MsgType$, ByVal SeedMsgID$,
ByVal flag&, ByVal Reserved&, MsgID$) As Long
Declare Function MAPIReadMail Lib "VBAMAP32.D LL" Alias "BMAPIReadM ail"
(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_RE QUESTED = 2
Global Const MAPI_SENT = 4

'************** *********
' FLAG Declarations
'************** *********
Global Const MAPI_LOGON_UI = &H1
Global Const MAPI_NEW_SESSIO N = &H2
Global Const MAPI_DIALOG = &H8
Global Const MAPI_UNREAD_ONL Y = &H20
Global Const MAPI_ENVELOPE_O NLY = &H40
Global Const MAPI_PEEK = &H80
Global Const MAPI_GUARANTEE_ FIFO = &H100
Global Const MAPI_BODY_AS_FI LE = &H200
Global Const MAPI_AB_NOMODIF Y = &H400
Global Const MAPI_SUPPRESS_A TTACH = &H800
Global Const MAPI_FORCE_DOWN LOAD = &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_DOWN LOAD, 0&, Session&)
rc& = MAPILogoff(Sess ion&, Hwnd, 0&, 0&)

If rc& = MAPI_SUCCESS Then
rc& = MAPILogon(0&, vbNullString, vbNullString, 0&, 0&,
Session&)
rc& = MAPIFindNext(Se ssion&, 0&, vbNullString, vbNullString, _
MAPI_GUARANTEE_ FIFO, 0&, MessageID)

Do While rc& = MAPI_SUCCESS
rc& = MAPIReadMail(Se ssion&, 0&, MessageID$, _
MAPI_ENVELOPE_O NLY, _
0&, Msg, Originator, aRecips(), aFiles())
If rc& = MAPI_SUCCESS Then

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

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

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

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(Se ssion&, 0&, vbNullString, MessageID$, _
0&, 0&, MessageID)
Loop

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

Roberto