[AccessD] Outlook and Access

Kath Pelletti kp at sdsonline.net
Fri May 12 02:41:45 CDT 2006


Rocky - I had a similiar requirement once and I used the following logic.

1. I made a subfolder of Inbox in Outlook and in my case called it 'Customer Inquiries'. 

2. Create a mail rule in Outlook which checks for the 6 digit code you are looking for and puts it into the subfolder you created in step 1.

3. The code I have pasted below comes from an app of mine which then uses an on-click event to read messages into a table in Access called TblOutlookMail from the Customer Inquiries folder in Outlook.  

Hope this help - cheers

--------------------------------------------------------------------------------

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
  '  MsgBox ("Inbox has: " & fld.Folders.Count & "subfolders.")
    
    Do Until IntFolderNo = IntTotalNoFoldersInInbox    ' Inner loop.
        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
    
    Debug.Print "Folder default item type: " & myfld.DefaultItemType
    
    If myfld.DefaultItemType <> olMailItem Then
       MsgBox "Folder does not contain mail messages; Exiting", , "Importing Mail"
       GoTo Normal_exit
    End If
    
    lngItemCount = myfld.Items.Count
    '   Debug.Print "Number of messages in folder: " _
    '      & lngItemCount
    
    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

   'Forms("frmOutlookMail").SetFocus
   
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 Pelletti

  ----- Original Message ----- 
  From: Rocky Smolin - Beach Access Software 
  To: Access Developers discussion and problem solving 
  Sent: Thursday, May 11, 2006 3:21 PM
  Subject: [AccessD] Outlook and Access


  Dear list:

  I have a request from a client to program something in Outlook but I 
  have no idea where to start.  Quote:

  "If an email comes in with a 6 digit (alphanumeric) code in the Subject 
  line, Outlook would make a call to Access, passing along the code and 
  then delete the email.  No code, email automatically deleted.  The call 
  to access would cause the code to be looked up and a status report 
  emailed to the client if the code is current. "

  I suppose the receipt of any email would have to trigger this hunk of 
  code. 

  I've put a lot of code behind Excel sheets to push data into an Access 
  database but never from Outlook.  Does anyone know of any code samples, 
  snips, explanations, etc. that could get me started on this?

  MTIA,

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



  -- 
  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