[AccessD] Outlook Automation

Got it.

Thanks again.

Rocky


Kath Pelletti wrote:
> 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
>   

-- 
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com