Access E-mail help question! (1 Viewer)

[kidrobot]

I have this code where it will find unread e-mail and store it to an Access table.

Option Explicit
Option Compare Binary

Private Sub ReadMail_Click()

Dim Olapp As Outlook.Application
    Dim Olmapi As Outlook.NameSpace
    Dim Olfolder As Outlook.MAPIFolder
    Dim OlAccept As Outlook.MAPIFolder
    Dim OlDecline As Outlook.MAPIFolder
    Dim OlFailed As Outlook.MAPIFolder
    Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
    Dim OlItems As Outlook.Items
    Dim OlRecips As Outlook.Recipients
    Dim OlRecip As Outlook.Recipient
    Dim Rst As Recordset
    Set Rst = CurrentDb.OpenRecordset("tbl_Temp") 'Open table tbl_temp
    
'Create a connection to outlook
    Set Olapp = CreateObject("Outlook.Application")
    Set Olmapi = Olapp.GetNamespace("MAPI")
    
'Open the inbox
    Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
    Set OlItems = Olfolder.Items
'Set up the folders the mails are going to be deposited in
'Set OlAccept = Olfolder.Folders("Accept")
'Set OlDecline = Olfolder.Folders("Decline")
'Set OlFailed = Olfolder.Folders("Failed")

'Reset the olitems object otherwise new incoming mails and moving mails get missed
    Set OlItems = Olfolder.Items
    For Each OlMail In OlItems
    
'For each mail in the collection check the subject line and process accordingly
    If OlMail.UnRead = True Then
       ' OlMail.UnRead = False 'Mark mail as read
        Rst.AddNew
        Rst!Name = OlMail.SenderName
        If OlMail.Subject Like "Bi-weekly status report" Then
            Rst!Subject = "Attending"
            Rst!datesent = OlMail.ReceivedTime
            Rst!Body = OlMail.Body
           ' OlMail.Move OlAccept
        ElseIf InStr(1, OlMail.Subject, "Decline") > 0 Then
            Rst!datesent = OlMail.ReceivedTime
            Rst!Subject = "Decline"
            Rst!Body = OlMail.Body
            'OlMail.Move OlDecline
        Else
            Rst!datesent = OlMail.ReceivedTime
            Rst!Subject = "Failed"
            Rst!Body = OlMail.Body
            'OlMail.Move OlFailed
        End If
        Rst.Update
    End If
    Next

    MsgBox "Your wish is my command. New mails have been checked. Please check the tbl_temp for details", vbOKOnly


End Sub

Instead of checking if I have an unread mail in my inbox I want to check the body of an e-mail and see if it has any bullets.

So something like ... If OlMail.has bullets? = True Then = True Then


I have this code to find bullets but I'm not sure how to incorporate it into the code

 Function FindBullets(WhichField As String) As String
  Dim intCounter As Integer
   Dim strbullets As String
   Dim intStart As Integer
   
  intStart = 1
  intCounter = 1
  strbullets = WhichField
   
   Do Until intCounter = 0
      'Chr(9) is the Tab character.
      'Replace Chr(9) with the ANSI code for the character
      'you are searching for.
     intCounter = InStr(intStart, strbullets, Chr(160))
      intStart = intCounter + 1
      If intCounter > 0 And Not IsNull(intCounter) Then
       strbullets = Replacebullets(intCounter, strbullets)
     End If
  Loop
   
  FindBullets = strbullets
End Function





'==================================================================
' The following function is called from the FindTabs() function. It
' accepts two arguments, intStart and strText. The function replaces tabs
' with %. It returns the updated text.
'==================================================================

Function Replacebullets(intStart As Integer, strbullets As String) As String
   ' Replace % with the character you want to substitute.
   Mid(strbullets, intStart, 1) = " "
   Replacebullets = strbullets
End Function

any help would be GREAT!!!!!!!

 

[kidrobot]

anyone????

can someone atleast show me how to do this...

If OlMail.Subject Like "Bi*" Then

 

[kidrobot]

nevermind i got it

 

[boblarson]

nevermind i got it

Since it would appear not many have that knowledge, would you be willing to share the results with everyone else? You might save someone the hassle you had to go through.

 

[kidrobot]

Yeah sure.. I'm still trying to figure out the bullets part, but this is what I have so far

        If OlMail.Subject Like "bi*" Then
            rst.AddNew
            rst!Name = OlMail.SenderName
            rst!Subject = "Report"
            rst!DateSent = OlMail.ReceivedTime
            rst!Body = OlMail.Body
            
        rst.Update
    End If
    Next