Re: Getting emails into MS Access - Code enclosed

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
 
"Id10 Terror" <noone@xxxxxxxxxxx> wrote in message news:udJfQU$1FHA.1332@xxxxxxxxxxxxxxxxxxxx...
> 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 *** 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
>
>
Loading