Getting emails into MS Access - Code enclosed

[Id10 Terror]

Hi:

I am using MS Outlook 2003 and MS Access 2003 for this project. I need to
run Access to pull emails out of Outlook into my tables automatically. I
fully understand that this code is old, but I can not find anything suitable
elsewhere. Redemption might work, but I can't find code that will do what I
want.

My problems with this are as follows:

1) After I run the code, I get the typical pain in the butt pop-up and I
click to run. It runs, but then locks up totally. Oddly enough, after I
end the tasks and open Access, the information is there, so something is
working properly. I do not get the message that emails have arrived either,
probably because it crashed before it got to that code.

2) My Outlook and Windows Messenger are also locked in my taskbar without
any way of closing or shutting them down.

3) I have 3 email folders in Outlook; ISBNEmail, ISBN-Passed, ISBN-Failed.
With Outlook rules, I send emails with "ISBN" in the subject to ISBNEmail.
Most of the time it works. Now, I want to use my code to access the ISBN
folder and check the criteria. Then move the email to 1 of the folders.
For some reason, I can not access any of the 3 folders with this code.

4) Not the biggest headache, but I am inserting the date and time of the
email in my table. Problem is that it puts the general date in each field.
I have tried dozens of formats but it doesn't work.

I know this is a lot to ask, but any help on these issues/problems would
greatly be appreciated.



Signed
Id10 Terror = Idiot Error


*************** MS Access code *******************************
'
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.NameSpace
Dim Olfolder As Outlook.MAPIFolder
'
'Set Olfolder = Olfolder.Folders("ISBNEmail")
Dim OlAccept As Outlook.MAPIFolder
Dim OlDecline As Outlook.MAPIFolder
Dim OlFailed As Outlook.MAPIFolder
Dim OlMail As Object ' Have to late bind as appointments e.t.c screw it up
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Rst As Recordset
'
Set Rst = CurrentDb.OpenRecordset("tblISBN_Hold01")
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
'Set OlAccept = Olfolder.Folders("ISBN-Passed")
'Set OlFailed = Olfolder.Folders("ISBN-Failed")
'
' Set up a loop to run till the inbox is empty (otherwise it skips some)
Do Until OlItems.Count = 0
'
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
'
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Mark mail as read
Rst.AddNew
Rst!ISBNHOLD_Hold102 = OlMail.SenderName
'
If InStr(1, OlMail.Subject, "ISBN") > 0 Then
Rst!ISBNHOLD_Hold201 = OlMail.Subject
Rst!ISBNHOLD_Hold002 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold003 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold001 = OlMail.Body
Rst!ISBNHOLD_Hold004 = "True"
' OlMail.Move OlAccept
Else
Rst!ISBNHOLD_Hold201 = OlMail.Subject
Rst!ISBNHOLD_Hold002 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold003 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold001 = OlMail.Body
Rst!ISBNHOLD_Hold004 = "False"
OlMail.Move OlFailed
End If
'
Rst.Update
'
End If
'
Next
'
Loop
MsgBox "Your wish is my command. New mails have been checked. Please check
the database for details", vbOKOnly
'
End Sub

 

[Dmitry Streblechenko]

1. There is absolutely no reason to loop through *all* messages in the Inbox looking for the unread messages. Use Items.Restrict/FindFirst instead ("[Unread] = True")
2. Your code moves the messages inside of the "for each" loop, thus changing the item count in the folder. Loop from Count down to 1 (step -1) instead.
3. To use Redemption to avoid the security prompt, change your code as follows:

set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = OlMail
Rst!ISBNHOLD_Hold102 = sItem.SenderName

If InStr(1, OlMail.Subject, "ISBN") > 0 Then
Rst!ISBNHOLD_Hold201 = OlMail.Subject
Rst!ISBNHOLD_Hold002 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold003 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold001 = sItem.Body
Rst!ISBNHOLD_Hold004 = "True"
' OlMail.Move OlAccept
Else
Rst!ISBNHOLD_Hold201 = OlMail.Subject
Rst!ISBNHOLD_Hold002 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold003 = OlMail.ReceivedTime
Rst!ISBNHOLD_Hold001 = sItem.Body
Rst!ISBNHOLD_Hold004 = "False"
OlMail.Move OlFailed
End If
'


Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool