"Steve" <sp**@nospam.com> escreveu na mensagem
news:MT*************@newsread2.news.atl.earthlink. 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.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
