[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