VBA code to enable a rule based on time of day for a IMAP mail account

[Guru]

Ive seen forums discussing rules to enable / disable rules based on time of day and or based on a task trigger using VBA codes, however those only work if teh account is a POP3 accoutn not when its an IMAP account.

Is there any way to get these codes to work on an IMAP account.

----
Sample VBA code on a POP account based on task trigger

Private Sub Application_Reminder(ByVal Item As Object)
If Item.MessageClass <> "IPM.Task" Then
Exit Sub
End If
If Item.Subject = "Enable Rule" Then
Enable_Run_Rule
End If
If Item.Subject = "Disable Rule" Then
Disable_Run_Rule
End If
End Sub
' Macro to enable a rule
Sub Enable_Run_Rule()
Dim olRules As Outlook.Rules
Dim olRule As Outlook.Rule
Dim intCount As Integer
Dim blnExecute As Boolean

Set olRules = Application.Session.DefaultStore.GetRules
Set olRule = olRules.Item(outofoffice)
olRule.Enabled = True
If blnExecute Then olRule.Execute ShowProgress:=True
olRules.Save

Set olRules = Nothing
Set olRule = Nothing
End Sub
' Macro to disable a rule
Sub Disable_Run_Rule()
Dim olRules As Outlook.Rules
Dim olRule As Outlook.Rule
Dim intCount As Integer
Dim blnExecute As Boolean

Set olRules = Application.Session.DefaultStore.GetRules
Set olRule = olRules.Item(outofoffice)
olRule.Enabled = False
If blnExecute Then olRule.Execute ShowProgress:=True
olRules.Save

Set olRules = Nothing
Set olRule = Nothing
End Sub
--

any help is greatly appriciated!!

 

[Michael Bauer]

There's no reason the code shouldn't work with IMAP. Do you get an error message, or did you check whether the code is executed at all?

 

[Guru]

correct, tried to run the code, getting error that it cannot run on this store, tried runing same code on a POP2 account works fine.

 

[Guru]

exact error message i get is

This store does not support rules. Could not complete the operation.

 

[Michael Bauer]

Thanks, now I see it. You need to find the imap account in Session.Stores, then call that Store's GetRules function.

 

[Guru]

The imap account is the only account in outlook, how else can i call it besides as i have wrote "Application.Session.DefaultStore"

 

[Michael Bauer]

IMAP is the default email account, that's what DefaultStore points to. The rules are stored in the default data file, which must be there if we're talking about OL 2010.

 

[Guru]

its indeed in OL2010,

but i'm not sure what you mean when you wrote "you need to find the imap account in Session.Stores, then call that Store's GetRules function"

 

[Michael Bauer]

Instead of calling DefaultStore, get the store by calling Session.Stores(Name).

BTW, I accidentally swapped it, DefaultStore points to the default data file, while the Rules are stored in the default email account. Anyway, that's why DefaultStore doesn't work.

 

[Guru]

i used the below code to get the full Session ID, and then called the SessionStores by the ID to no avail, giving me the same exact error

-- Code used to obtain ID
Public Sub GetListOfStores()
On Error GoTo On_Error

Dim Session As Outlook.NameSpace
Dim Store As Outlook.Store
Dim Stores As Outlook.Stores
Dim Report As String

Set Session = Application.Session

Set Stores = Session.Stores
For Each Store In Stores
Report = Report & Store.DisplayName & vbCrLf
Report = Report & "Location : " & Store.FilePath & vbCrLf
Report = Report & "Is Cached Exchange : " & Store.IsCachedExchange & vbCrLf
Report = Report & "Is Data File Store : " & Store.IsDataFileStore & vbCrLf
Report = Report & "Is Instant Search Enabled : " & Store.IsInstantSearchEnabled & vbCrLf
Report = Report & "Is Open : " & Store.IsOpen & vbCrLf
Report = Report & "Class : " & Store.Class & vbCrLf
Report = Report & "Exchange Store Type : " & Store.ExchangeStoreType & vbCrLf
Report = Report & "Store ID : " & Store.StoreID & vbCrLf & vbCrLf
Next Store

Dim retValue As Boolean
retValue = CreateReportAsEmail("List of Stores", Report)

Exiting:
Set Session = Nothing
Exit Sub
On_Error:
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting
End Sub

Public Function CreateReportAsEmail(Title As String, Report As String)
On Error GoTo On_Error

Dim Session As Outlook.NameSpace
Dim mail As MailItem
Dim MyAddress As AddressEntry
Dim Inbox As Outlook.Folder

CreateReportAsEmail = True

Set Session = Application.Session
Set Inbox = Session.GetDefaultFolder(olFolderInbox)
Set mail = Inbox.Items.Add("IPM.Mail")

Set MyAddress = Session.CurrentUser.AddressEntry
mail.Recipients.Add (MyAddress.Address)
mail.Recipients.ResolveAll

mail.Subject = Title
mail.Body = Report

mail.Save
mail.Display


Exiting:
Set Session = Nothing
Exit Function
On_Error:
CreateReportAsEmail = False
MsgBox "error=" & Err.Number & " " & Err.Description
Resume Exiting
End Function

-

 

[Michael Bauer]

Maybe I'm missing anything but that code doesn't call GetRules. Where do you get the error "This store does not support rules"?

 

[Guru]

the code above provides me the full valid store ID, which didnt fix the issue, unless i wasnt correctly using the store ID in calling the session.

If possible can you please type out the full line how i have it and how you woulr have it instead

 

[Michael Bauer]

Are you still trying to get the rules, or are we talking about another issue now? Only one of the stores supports rules, for all of the other stores calling GetRules raises an error. If you don't know its name, you can solve it this way:

on error resume next
for each store in stores
  set rules=store.getrules
  if not rules is nothing then exit for
next

 

[Guru]

still trying to get the rules to work on outlook 2010 using an imap account.

question above asked whihc line of my code do i have to replace to get it to work and what do i replace it with

 

[Michael Bauer]

Return to the first code you posted. There see where you call GetRules. Loop through the Stores collection as demonstrated above and ignore the error. One of the GetRules calls will succeed.