Kath Pelletti
kp at sdsonline.net
Fri Jun 2 00:26:23 CDT 2006
Rocky - what I did to get around that in my app was add an Outlook mail rule to put messages with a specific 'To' address into the correct subfolder of Inbox. That way you *know" you've got the right ones. Otherwise, from the vba side of things, the item has a '.To' property just as it has a '.CC', '.Body' property etc. HTH Kath ----- Original Message ----- From: Rocky Smolin - Beach Access Software To: Access Developers discussion and problem solving Sent: Friday, June 02, 2006 2:43 PM Subject: Re: [AccessD] Outlook Automation Kath: Thank you. Thank you. Thank you. That's what I need. I have to check the "To" to make sure it's coming in to a specific mail address. Do you know offhand what the syntax is for that? Thanks again and regards, Rocky Kath Pelletti wrote: > Rocky - here it is again. > > This works to retrieve mail messages if you put them in a subfolder of Inbox (in my case 'Customer Inquiries'.) > > -------------------------------------------------------------------------------- > > Public Function ProcessMailMessagesInFolder() > 'Adapted by K Pelletti from code from Helen Feddema 3-28-2002 > Dim strerrormsg As String > On Error GoTo Err_Handler > > Dim appOutlook As New Outlook.Application > > Dim nms As Outlook.NameSpace > Dim fld As Outlook.MAPIFolder > Dim myfld As Outlook.MAPIFolder > > Dim itm As Object > Dim msg As Outlook.MailItem > Dim strMessage As String > Dim dbs As DAO.Database > Dim rst As DAO.Recordset > Dim strsql As String > Dim prj As Object > Dim lngItemCount As Long > Dim IntFolderNo As Integer > Dim IntTotalNoFoldersInInbox As Integer > Dim IntNoMailItems As Integer > Dim BoolFolderFound As Boolean > BoolFolderFound = False > > Set nms = appOutlook.GetNamespace("MAPI") > Set fld = nms.GetDefaultFolder(olFolderInbox) > IntFolderNo = 0 > IntTotalNoFoldersInInbox = 0 > IntNoMailItems = 0 > IntTotalNoFoldersInInbox = fld.Folders.Count > > Do Until IntFolderNo = IntTotalNoFoldersInInbox > IntFolderNo = IntFolderNo + 1 > Set myfld = fld.Folders(IntFolderNo) > If myfld.Name = "Customer Inquiries" Then 'Rocky - put your subfolder Outlook name here > BoolFolderFound = True > IntNoMailItems = myfld.Items.Count > ' MsgBox ("No messages is: " & IntNoMailItems) > Exit Do > End If > Loop > > If BoolFolderFound = False Then > MsgBox ("Unable to find the Customer Inquiries Folder in Outlook." & vbCrLf & vbCrLf & "(The folder should be a subfolder of inbox.)"), , "Hudsons Database" > GoTo Normal_exit > End If > > If myfld Is Nothing Then > GoTo Err_Handler > End If > > If myfld.DefaultItemType <> olMailItem Then > MsgBox "Folder does not contain mail messages; Exiting", , "Importing Mail" > GoTo Normal_exit > End If > > lngItemCount = myfld.Items.Count > > If lngItemCount = 0 Then > MsgBox ("There are no mail messages in the Customer Inquiries folder."), , "Hudsons Database" > GoTo Normal_exit > End If > > 'Process items in selected folder > strsql = "DELETE * FROM tblOutlookMail" > DoCmd.SetWarnings False > DoCmd.RunSQL strsql > Set dbs = CurrentDb > Set rst = dbs.OpenRecordset("tblOutlookMail") > > For Each itm In myfld.Items > If itm.Class = olMail Then > Set msg = itm > With rst > .AddNew > !Subject = msg.Subject > !Body = msg.Body > !CC = msg.CC > !BCC = msg.BCC > !Sent = msg.SentOn > !FromName = msg.SenderName > .Update > End With > End If > Next itm > rst.Close > > Set prj = Application.CurrentProject > > If prj.AllForms("frmOutlookMail").IsLoaded = True Then > Forms("frmOutlookMail").Requery > Else > DoCmd.OpenForm "frmOutlookMail", , , , , acDialog > End If > > > Normal_exit: > ' MsgBox ("No of new mail messages: " & IntNoMailItems), , "Mail Import" > Exit Function > Err_Handler: > MsgBox "Error: [" & Err.Number & "] " & IIf(Len(strerrormsg) > 0, strerrormsg, Err.Description), vbCritical, "Error Message" > hCursor = CursorID > RetVal = SetCursor(hCursor) > Resume Normal_exit > > End Function > Kath > -- Rocky Smolin Beach Access Software 858-259-4334 www.e-z-mrp.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com