In a code module, use Tools References to set one for Outlook.
Then modify this code to do what you need.
Public Sub SaveAttachment(strPath As String)
On Error GoTo Err_SaveAttachment
Dim ol As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim MyInbox As Outlook.Items
Dim fldr As Outlook.MAPIFolder
Dim itm As Outlook.MailItem
Dim mFile As String, NumAttachments As Integer, i As Integer, NumEmails As
Integer, strTo As String
Set ns = ol.GetNamespace("MAPI")
Set MyInbox = ns.GetDefaultFolder(olFolderInbox).Items
'set a reference to a folder to move the items to
Set fldr = ns.Folders("Personal Folders").Folders("Saved
Messages").Folders("Bids")
For Each itm In MyInbox
'Debug.Print itm.Subject, itm.To, itm.SenderName
If itm.Subject Like "*Bid*" Then
NumAttachments = itm.Attachments.Count
i = 1 'attachment number
Do While i <= NumAttachments
mFile = itm.Attachments.Item(i).filename
itm.Attachments.Item(i).SaveAsFile strPath & mFile
i = i + 1
Loop
Else
'Debug.Print "Not a Bid"
End If
Next
'In order to move all messages from one folder to another, you must loop
backwards through the index
NumEmails = MyInbox.Count
For i = NumEmails To 1 Step -1
If MyInbox.Item(i).Subject Like "*Bid*" Then
Set itm = MyInbox.Item(i)
'Get e-mail address for the acknowledgment from the Body of the
original message
strTo = GetAddress(itm.Body)
Call SendEmailMessage("This is to acknowledge that your Bid has been
received and will be processed shortly.", "This is the body of your message
to us:" & vbCRLF & itm.Body, strTo)
itm.Move fldr
End If
Next i
Exit_SaveAttachment:
Set itm = Nothing
Set MyInbox = Nothing
Set ns = Nothing
Set ol = Nothing
Exit Sub
Err_SaveAttachment:
MsgBox ("Error # " & str(Err.Number) & " was generated by " & Err.Source &
Chr(13) & Err.Description)
Resume Exit_SaveAttachment
End Sub
Sub SendEmailMessage(strSubject As String, strBody As String, strTo As
String)
On Error GoTo Err_SendEmailMessage
Dim ol As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim newMail As Outlook.MailItem
Set ns = ol.GetNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
With newMail
.Subject = strSubject
.Body = strBody & vbCRLF
With .Recipients.Add(strTo)
.Type = olTo
End With
.Send
End With
Exit_SendEmailMessage:
Set ol = Nothing
Set ns = Nothing
Set newMail = Nothing
Exit Sub
Err_SendEmailMessage:
MsgBox ("Error # " & str(Err.Number) & " was generated by " & Err.Source &
Chr(13) & Err.Description)
Resume Exit_SendEmailMessage
End Sub
You may need to use a program named ClickYes! in order to use the
SendEmailMessage code.
Oultook security now pops up dialog boxes that you can't program around.
ClickYes! looks for them and "clicks the Yes button" for your code.
http://www.express-soft.com/mailmate/clickyes.html
--
Joe Fallon
Access MVP
bdepalma said:
I want to import outlook messages and it's Excell attachments to two
tables to Access that will be linked one to many relationship. The one side
of the relationship would be the outlook message, and the many side of the
relationship would be the excel attachment. Does anybody know how to import
the outlook message and it's attachment to two tables automatically and
create the link between those two tables. Any help is appreciated.
