起動時にすべてのルールを有効化する


ルールでマクロを実行する設定を行っている場合に、マクロがエラーとなってルールが無効化されてしまうという現象が発生するようです。
このような現象が発生した場合、ルールを手動で有効化する必要があるのですが、起動時などに自動的にオンにできないかというご相談をうけました。

そこで、起動時にルールをすべて有効化するマクロを作ってみました。マクロは以下の通りです。EnableAllRules をクイック アクセス ツールバーなどに登録しておけば、エラーが発生した後にワンクリックで有効化させることができます。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_Startup()
    EnableAllRules
End Sub
'
Public Sub EnableAllRules()
    On Error Resume Next
    Dim objStore As Store
    Dim colRules As Rules
    Dim objRule As Rule
    For Each objStore In Application.Session.Stores
        Set colRules = objStore.GetRules
        For Each objRule In colRules
            objRule.Enabled = True 
        Next
        colRules.Save
    Next
End Sub

マクロの登録方法やメニューへの追加について

起動時にすべてのルールを有効化する」への1件のフィードバック

  1. 飯岡と申します。

    以下の場合に発生し、問題が解消しない場合があります。
    定期的な会議の予約などを行い、自動承認する場合、自動的にメールが消えるよう(自動処理により)で
    この瞬間にエラー画面が発生し、このエラー画面がある状態では、有効化が行えないようです。

    (エラー通知の画面が出ている場合は、何もできないため)

    対策として以下を講じています。
    VBSを使って、無効なルールがある場合は、outlookプロセス自体を落とす。
    outlookプロセス

    VBS<5分おきにチェック>
    Const olFolderInbox = 6
    Dim rc
    if RuleCheck() = false then
    KillProcess()
    else

    end if

    Private Function RuleCheck()

    Dim Application
    Set Application = CreateObject(“Outlook.Application”)

    Dim st ‘As Outlook.Store
    Dim myRules ‘As Outlook.Rules
    Dim rl ‘As Outlook.Rule
    Dim count ‘As Integer
    Dim ruleList ‘As String

    Set st = Application.Session.DefaultStore
    Dim rst
    rst = true
    Set myRules = st.GetRules
    Dim ruleInfo ‘As String
    ‘ iterate all the rules
    For Each rl In myRules
    if rl.Enabled=false then
    rst=false
    rc=rc & ” ” & rl.Name
    ‘ rl.Enabled=true
    ‘ myRules.Save
    end if
    Next
    RuleCheck=rst

    End Function

    Private Function SendMail()

    Set olkApp = CreateObject(“Outlook.Application”)
    Set objMsg = olkApp.CreateItem(0) ‘ 0 = olMailItem
    objMsg.To = “iioka_masashi@ajs.co.jp” ‘ 宛先を指定
    objMsg.Subject = “outlook Rule was レスキュー” ‘ 件名を指定
    objMsg.Body = rc ‘ 本文を指定
    objMsg.Send ‘ メールを送信

    End Function

    Private Function KillProcess()

    strComputer = “.”
    Set objWMIService = GetObject(“winmgmts:” _
    & “{impersonationLevel=impersonate}!\\” & strComputer & “\root\cimv2”)
    Set colProcessList = objWMIService.ExecQuery _
    (“SELECT * FROM Win32_Process where Name = ‘outlook.exe'”)

    flg=false

    For Each objProcess in colProcessList
    colProperties = objProcess.GetOwner(strNameOfUser,strUserDomain)

    if strNameOfUser = “j979051” then
    objProcess.Terminate
    flg=true
    end if

    Next

    if flg = true then

    Const vbHide = 0 ‘ウィンドウを非表示
    Const vbNormalFocus = 1 ‘通常のウィンドウ、かつ最前面のウィンドウ
    Const vbMinimizedFocus = 2 ‘最小化、かつ最前面のウィンドウ
    Const vbMaximizedFocus = 3 ‘最大化、かつ最前面のウィンドウ
    Const vbNormalNoFocus = 4 ‘通常のウィンドウ、ただし、最前面にはならない
    Const vbMinimizedNoFocus = 6 ‘最小化、ただし、最前面にはならない

    Dim objWShell

    Set objWShell = CreateObject(“WScript.Shell”)

    objWShell.Run “””C:\Program Files\Microsoft Office\Office14\outlook.exe”””, vbNormalFocus, False

    Set objWShell = Nothing

    Set olkApp = CreateObject(“Outlook.Application”)
    Set objMsg = olkApp.CreateItem(0) ‘ 0 = olMailItem
    objMsg.To = “アドレス” ‘ 宛先を指定
    objMsg.Subject = “レスキュー” ‘ 件名を指定
    objMsg.Body = rc
    objMsg.Send ‘ メールを送信

    end if

    End Function

    <startup実行>

    Private Sub Application_Startup()
    Call EnableAllRules
    End Sub

    Public Sub EnableAllRules()
    On Error Resume Next
    Dim objStore As Store
    Dim colRules As Rules
    Dim objRule As Rule
    Dim blnExecute As Boolean

    For Each objStore In Application.Session.Stores
    Set colRules = objStore.GetRules

    For Each objRule In colRules
    Debug.Print objRule.Name
    objRule.Enabled = True

    Next
    colRules.Save
    Next

    End Sub

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中