I have this code where it will find unread e-mail and store it to an Access table.
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
any help would be GREAT!!!!!!!
Code:
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
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!!!!!!!