[AccessD] Outlook Automation

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



More information about the AccessD mailing list