Go to Qiita Advent Calendar 2024 Top
LoginSignup
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

@Q11Q

OUTLOOK VBA VerUP 仕分けルールを分析する Rule Analyze

Last updated at Posted at 2017-11-21

#仕訳ルール自体はOUTLOOKで作成する方が簡単
なので今回のVBAはイミディエイトに表示させるだけです。というわけにもいかないので、テキスト出力を付加しました。

##インデックス番号の把握

Outlookは個人でもメールアドレスと保存先の2つのStoreを使っていることが通常です。
Storeとはメール、保存先といったフォルダの集合体のことをいいます。

ファミリーマートの受信フォルダと送信済みフォルダ
ローソンの受信フォルダと送信済みフォルダ

というようにコンビニの名前のところがID、つまりメールアドレス、保存先になります。
なので自分の探したいストアのID番号を探ります。
これがわかったら
Set olStore = olStores.Item(1)
にインデックス番号を入れます。現在1番が入っています。普通は1番じゃないかな。

##保存先
Const sFilename = "C:\hoge\olRuleDebugPrint.txt"
を書き換えてください。

ruleliset2
Sub ruleliset2()
'https://msdn.microsoft.com/ja-jp/VBA/Outlook-VBA/articles/specifying-rule-actions
'https://msdn.microsoft.com/ja-jp/vba/outlook-vba/articles/olruleactiontype-enumeration-outlook
'https://msdn.microsoft.com/ja-jp/vba/outlook-vba/articles/ruleaction-actiontype-property-outlook
'https://msdn.microsoft.com/ja-jp/vba/outlook-vba/articles/ruleaction-object-outlook
'https://msdn.microsoft.com/ja-jp/vba/outlook-vba/articles/ruleaction-enabled-property-outlook
Dim ns As NameSpace: Set ns = Application.GetNamespace("MAPI")
Dim olStores As Outlook.Stores, olStore As Outlook.Store
Dim oROOT, olFolders As Outlook.folders, olFolder As Outlook.Folder, olRules As Outlook.Rules, olRule As Outlook.Rule, olRuleAcs As Outlook.RuleActions, olRuleAc As Outlook.RuleAction, olRuleCons As Outlook.RuleConditions, olRuleCon As Outlook.RuleCondition
Dim i As Long, i1 As Long
Dim i2 As Long
Set olStores = ns.Stores
For Each olStore In olStores
Debug.Print olStore.DisplayName, olStore.StoreID
Next
For i = 1 To olStores.Count
Debug.Print i & vbTab & olStores.Item(i).DisplayName
Next
'上のFor nextでインデックス番号をつかむ
Set olStore = olStores.Item(3)
Set oROOT = olStore.GetRootFolder
Set olRules = olStore.GetRules()
On Error Resume Next
For i = 1 To olRules.Count
Set olRule = olRules.Item(i)
Debug.Print "Typename : " & TypeName(olRule)
Debug.Print "Exceptions : " & olRule.Exceptions.Count
If olRule.Exceptions.Count > 0 Then
For i2 = 1 To olRule.Exceptions.Count
fnDebugPrint (olRule.Name & ":Exceptions:" & i2 & ":" & olRule.Exceptions.Item(i2).ConditionType)
Next i2
End If

If Err.Number <> 0 Then Debug.Print "Err Idx:=" & i & " " & Err.Number, Err.Description
Set olRuleCons = olRule.Conditions
printArray olRule.Conditions.Body.Text
printArray olRule.Conditions.MessageHeader.Text
printArray olRule.Conditions.BodyOrSubject.Text
printArray olRule.Conditions.Subject.Text
fnDebugPrint (olRule.Name & ":ExecOrder" & olRule.ExecutionOrder)
fnDebugPrint (olRule.Name & ":IsLocalRule" & olRule.IsLocalRule)
fnDebugPrint (olRule.Name & ":RuleType" & olRule.RuleType)
Debug.Print "Account:" & olRule.Conditions.Account & ":" & olRule.Conditions.Account.Enabled & ":" & olRule.Conditions.Account.Account.UserName: fnDebugPrint (olRule.Name & ":Account:" & olRule.Conditions.Account & ":" & olRule.Conditions.Account.Enabled & ":" & olRule.Conditions.Account.Account.UserName)

Debug.Print "AnyCategory:" & olRule.Conditions.AnyCategory & ":" & olRule.Conditions.AnyCategory.Enabled & ":" & olRule.Conditions.AnyCategory.ConditionType: fnDebugPrint (olRule.Name & ":AnyCategory:" & olRule.Conditions.AnyCategory & ":" & olRule.Conditions.AnyCategory.Enabled & ":" & olRule.Conditions.AnyCategory.ConditionType)

Debug.Print "Category" & olRule.Conditions.Category: fnDebugPrint (olRule.Name & ":Category" & olRule.Conditions.Category)

Debug.Print "CC:" & olRule.Conditions.CC & ":" & olRule.Conditions.CC.Enabled & ":" & olRule.Conditions.CC.ConditionType: fnDebugPrint (olRule.Name & ":CC:" & olRule.Conditions.CC & ":" & olRule.Conditions.CC.Enabled & ":" & olRule.Conditions.CC.ConditionType)

Debug.Print "FormName:" & olRule.Conditions.FormName.Enabled & ":" & olRule.Conditions.FormName.ConditionType & ":" & olRule.Conditions.FormName.FormName: fnDebugPrint (olRule.Name & ":FormName:" & olRule.Conditions.FormName.Enabled & ":" & olRule.Conditions.FormName.ConditionType & ":" & olRule.Conditions.FormName.FormName)
Debug.Print "From:" & olRule.Conditions.From.Recipients.Item(1): fnDebugPrint (olRule.Name & ":From:" & olRule.Conditions.From.Recipients.Item(1))
If olRule.Conditions.From.Recipients.Count > 0 Then
fnDebugprintRecipientsList (olRule.Conditions.From.Recipients)
End If
Debug.Print "HasAttchment:" & olRule.Conditions.HasAttachment.Enabled & ":" & olRule.Conditions.HasAttachment.ConditionType: fnDebugPrint (olRule.Name & ":HasAttchment:" & olRule.Conditions.HasAttachment.Enabled & ":" & olRule.Conditions.HasAttachment.ConditionType)

Debug.Print "MeetingInviteOrUpdate:" & olRule.Conditions.MeetingInviteOrUpdate & ":" & olRule.Conditions.MeetingInviteOrUpdate.Enabled & ":" & olRule.Conditions.MeetingInviteOrUpdate.ConditionType: fnDebugPrint (olRule.Name & ":MeetingInviteOrUpdate:" & olRule.Conditions.MeetingInviteOrUpdate & ":" & olRule.Conditions.MeetingInviteOrUpdate.Enabled & ":" & olRule.Conditions.MeetingInviteOrUpdate.ConditionType)

Debug.Print "NotTo:" & olRule.Conditions.NotTo.Enabled & ":" & olRule.Conditions.NotTo.ConditionType: fnDebugPrint (olRule.Name & ":NotTo:" & olRule.Conditions.NotTo.Enabled & ":" & olRule.Conditions.NotTo.ConditionType)

Debug.Print "OnlyToMe:" & olRule.Conditions.OnlyToMe.Enabled & ":" & olRule.Conditions.OnlyToMe.ConditionType: fnDebugPrint (olRule.Name & ":OnlyToMe:" & olRule.Conditions.OnlyToMe.Enabled & ":" & olRule.Conditions.OnlyToMe.ConditionType)

Debug.Print "OnLocalMachine:" & olRule.Conditions.OnLocalMachine & ":" & olRule.Conditions.OnLocalMachine.Enabled & ":" & olRule.Conditions.OnLocalMachine.ConditionType: fnDebugPrint (olRule.Name & ":OnLocalMachine:" & olRule.Conditions.OnLocalMachine & ":" & olRule.Conditions.OnLocalMachine.Enabled & ":" & olRule.Conditions.OnLocalMachine.ConditionType)

Debug.Print "ToMe:" & olRule.Conditions.ToMe & ":" & olRule.Conditions.ToMe.Enabled & ":" & olRule.Conditions.ToMe.ConditionType: fnDebugPrint (olRule.Name & ":ToMe:" & olRule.Conditions.ToMe & ":" & olRule.Conditions.ToMe.Enabled & ":" & olRule.Conditions.ToMe.ConditionType)

Debug.Print "subject:" & olRule.Conditions.Subject & ":" & olRule.Conditions.Subject.Enabled & ":" & olRule.Conditions.Subject.ConditionType & ":" & olRule.Conditions.Subject.Text: fnDebugPrint (olRule.Name & ":subject:" & olRule.Conditions.Subject & ":" & olRule.Conditions.Subject.Enabled & ":" & olRule.Conditions.Subject.ConditionType & ":" & olRule.Conditions.Subject.Text)
Debug.Print "SenderAddress:" & olRule.Conditions.SenderAddress & ":" & olRule.Conditions.SenderAddress.Enabled & ":" & olRule.Conditions.SenderAddress.ConditionType & ":" & olRule.Conditions.SenderAddress.Address: fnDebugPrint (olRule.Name & ":SenderAddress:" & olRule.Conditions.SenderAddress & ":" & olRule.Conditions.SenderAddress.Enabled & ":" & olRule.Conditions.SenderAddress.ConditionType & ":" & olRule.Conditions.SenderAddress.Address)
Debug.Print "SenderInAddressList:" & olRule.Conditions.SenderInAddressList & ":" & olRule.Conditions.SenderInAddressList.AddressList.Name: fnDebugPrint (olRule.Name & ":SenderInAddressList:" & olRule.Conditions.SenderInAddressList & ":" & olRule.Conditions.SenderInAddressList.AddressList.Name)
Debug.Print "ToOrCc:" & olRule.Conditions.ToOrCc & ":" & olRule.Conditions.ToOrCc.Enabled & ":" & olRule.Conditions.MeetingInviteOrUpdate.ConditionType
Set olRuleAcs = olRule.Actions
For i1 = 1 To olRule.Actions.Count
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMoveToFolder Then
Debug.Print "Move To Folder: " & olRule.Actions.MoveToFolder.Folder.folderPath
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionAssignToCategory Then
Debug.Print olRule.Name, ":", i1, ":", "Assign To Category: " & olRule.Actions.AssignToCategory.ActionType
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionCopyToFolder Then
Debug.Print olRule.Name, ":", i1, ":", "Copy To Folder: " & olRule.Actions.CopyToFolder.Folder.folderPath: fnDebugPrint (olRule.Name & ":" & i1 & ":" & "Copy To Folder: " & olRule.Actions.CopyToFolder.Folder.folderPath)
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDeletePermanently Then
Debug.Print olRule.Name, ":", i1, ":", "DeletePermanently: " & olRule.Actions.DeletePermanently.ActionType & ":" & olRule.Actions.DeletePermanently.Enabled: fnDebugPrint (olRule.Name & ":" & i1 & ":" & "DeletePermanently: " & olRule.Actions.DeletePermanently.ActionType & ":" & olRule.Actions.DeletePermanently.Enabled)
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDesktopAlert Then
Debug.Print olRule.Name, ":", i1, ":", "DeletePermanently: " & olRule.Actions.DesktopAlert.ActionType & ":" & olRule.Actions.DesktopAlert.Enabled
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDelete Then
Debug.Print olRule.Name, ":", i1, ":", "Delete: " & olRule.Actions.Delete.ActionType & ":" & olRule.Actions.Delete.Enable
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDefer Then
Debug.Print olRule.Name, ":", i1, ":", "Defer: "
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForward Then
Debug.Print olRule.Name, ":", i1, ":", "Forward: " & olRule.Actions.Forward.ActionType & ":" & olRule.Actions.Forward.Enabled; ":" & olRule.Actions.Forward.Enabled & ":Rep:" & olRule.Actions.Forward.Recipients.Count & ":1:" & olRule.Actions.Forward.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionImportance Then Debug.Print olRule.Name, ":", i1, ":", "Importance: "
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
If olRule.Actions.ForwardAsAttachment.Recipients.Count > 0 Then
fnDebugprintRecipientsList (olRule.Actions.ForwardAsAttachment.Recipients)
End If
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMarkAsTask Then
Debug.Print olRule.Name, ":", i1, ":", "MarkAsTask: " & olRule.Actions.MarkAsTask.FlagTo & ":" & olRule.Actions.MarkAsTask.Enabled & ":" & olRule.Actions.MarkAsTask.MarkInterval
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMarkRead Then
Debug.Print olRule.Name, ":", i1, ":", "MarkRead: "
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionNewItemAlert Then
Debug.Print olRule.Name, ":", i1, ":", "NewItemAlert: " & olRule.Actions.NewItemAlert.ActionType & ":" & olRule.Actions.NewItemAlert.Enabled & ":Text:" & olRule.Actions.NewItemAlert.Text
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionNotifyDelivery Then Debug.Print olRule.Name, ":", i1, ":", "NortifyDelivery:", olRule.Actions.NotifyDelivery.ActionType & ":" & olRule.Actions.NotifyDelivery.Enabled
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionFlagClear Then Debug.Print olRule.Name, ":", i1, ":", "FlagClear:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionFlagColor Then Debug.Print olRule.Name, ":", i1, ":", "FlagColor:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionClearCategories Then Debug.Print olRule.Name, ":", i1, ":", "ClearCategories:" & olRule.Actions.ClearCategories.ActionType & ":" & olRule.Actions.ClearCategories.Enabled
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionPlaySound Then Debug.Print olRule.Name, ":", i1, ":", "PlaySount:" & olRule.Actions.PlaySound.ActionType & ":" & olRule.Actions.PlaySound.Enabled & ":" & olRule.Actions.PlaySound.FilePath
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionPrint Then Debug.Print olRule.Name, ":", i1, ":", "Print:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionRedirect Then
Debug.Print olRule.Name, ":", i1, ":", "Redirect:" & olRule.Actions.Redirect.ActionType & ":" & olRule.Actions.Redirect.Enabled & ":" & olRule.Actions.Redirect.Recipients.Count & ":" & olRule.Actions.Redirect.Recipients.Item(1).Address
If olRule.Actions.Redirect.Recipients.Count > 0 Then
fnDebugprintRecipientsList (oRule.Actions.Redirect.Recipients)
End If
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionRunScript Then Debug.Print olRule.Name, ":", i1, ":", "RunScript:": fnDebugPrint (olRule.Name & ":" & i1 & ":" & "RunScript:")
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionSensitivity Then Debug.Print olRule.Name, ":", i1, ":", "Sensitivity:": fnDebugPrint (olRule.Name & ":" & i1 & ":" & "Sensitivity:")
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionStop Then fnDebugPrint (olRule.Name & ":" & i1 & ":" & "Stop:" & olRule.Actions.Stop.ActionType & ":" & olRule.Actions.Stop.Enabled)
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionUnknown Then fnDebugPrint (olRule.Name & ":" & i1 & ":" & "Unknown:")
Next i1
'https://msdn.microsoft.com/ja-jp/VBA/Outlook-VBA/articles/specifying-rule-conditions
'https://social.technet.microsoft.com/Forums/scriptcenter/en-US/f848fea4-e01f-4347-8524-a442a9aedf77/identify-outlook-move-rules-with-vbscript?forum=ITCG
Next
End Sub
Function fnDebugprintRecipientsList(reps As Outlook.Recipients)
Dim rep As Outlook.Recipient
Dim cnt As Long
If reps.Count > 0 Then
cnt = 1
For Each rep In reps
Debug.Print rep.Address, rep.Name, ":", cnt & "/" & reps.Count
fnDebugPrint (rep.Address & rep.Name & ":" & rep.DisplayType & ":" & rep.Type)
Next
End If
End Function

Function fnDebugPrint(str)
Const sFilename = "C:\hoge\olRuleDebugPrint.txt"
Dim fso As Scripting.FileSystemObject: Set fso = New Scripting.FileSystemObject
Dim oFile: If fso.FileExists(sFilename) = False Then fso.CreateTextFile sFilename, True, True
Dim buf

If TypeName(str) = "String" Then
With fso.GetFile(sFilename).OpenAsTextStream(ForAppending, TristateUseDefault)
'If Err.Number <> 0 Then .WriteLine Err.Number & "," & Err.Description: Debug.Print Err.Number & "," & Err.Description: Err.Clear
.WriteLine str
.Close
End With
End If
If IsArray(str) Then
With fso.GetFile(sFilename).OpenAsTextStream(ForAppending, TristateUseDefault)
'If Err.Number <> 0 Then .WriteLine Err.Number & "," & Err.Description: Debug.Print Err.Number & "," & Err.Description: Err.Clear
For Each buf In str
'If Err.Number <> 0 Then .WriteLine Err.Number & "," & Err.Description: Debug.Print Err.Number & "," & Err.Description: Err.Clear
.WriteLine CStr(buf)
.Close
Next
End With
End If
End Function

Private Sub printArray(ByRef pArr As Variant)
Dim readString As Variant
If (IsArray(pArr)) Then 'check if the passed variable is an array
For Each readString In pArr
If TypeName(readString) = "String" Then 'check if the readString is a String variable
Debug.Print readString
fnDebugPrint (readString)
End If
Next
End If
End Sub
Rulelist
Sub Rulelist()
Dim ns As NameSpace: Set ns = Application.GetNamespace("MAPI")
Dim olStores As Outlook.Stores, olStore As Outlook.Store
Dim oROOT, olFolders As Outlook.folders, olFolder As Outlook.Folder, olRules As Outlook.Rules, olRule As Outlook.Rule, olRuleAcs As Outlook.RuleActions, olRuleAc As Outlook.RuleAction, olRuleCons As Outlook.RuleConditions, olRuleCon As Outlook.RuleCondition
Dim i As Long, i1 As Long

Set olStores = ns.Stores
For Each olStore In olStores
Debug.Print olStore.DisplayName, olStore.StoreID
Next
For i = 1 To olStores.Count
Debug.Print i & vbTab & olStores.Item(i).DisplayName
Next
'上のFor nextでインデックス番号をつかむ
Set olStore = olStores.Item(1)
Set oROOT = olStore.GetRootFolder
Set olRules = olStore.GetRules()
On Error Resume Next
For i = 1 To olRules.Count
Set olRule = olRules.Item(i)
Debug.Print "Typename : " & TypeName(olRule)
If Err.Number <> 0 Then Debug.Print "Err Idx:=" & i & " " & Err.Number, Err.Description
Set olRuleCons = olRule.Conditions
printArray olRule.Conditions.Body.Text
printArray olRule.Conditions.MessageHeader.Text
printArray olRule.Conditions.BodyOrSubject.Text
printArray olRule.Conditions.Subject.Text
Debug.Print "Account:" & olRule.Conditions.Account & ":" & olRule.Conditions.Account.Enabled & ":" & olRule.Conditions.Account.Account.UserName
Debug.Print "AnyCategory:" & olRule.Conditions.AnyCategory & ":" & olRule.Conditions.AnyCategory.Enabled & ":" & olRule.Conditions.AnyCategory.ConditionType
Debug.Print "Category" & olRule.Conditions.Category
Debug.Print "CC:" & olRule.Conditions.CC & ":" & olRule.Conditions.CC.Enabled & ":" & olRule.Conditions.CC.ConditionType
Debug.Print "FormName:" & olRule.Conditions.FormName.Enabled & ":" & olRule.Conditions.FormName.ConditionType & ":" & olRule.Conditions.FormName.FormName
Debug.Print "From:" & olRule.Conditions.From.Recipients.Item(1)
Debug.Print "HasAttchment:" & olRule.Conditions.HasAttachment.Enabled & ":" & olRule.Conditions.HasAttachment.ConditionType
Debug.Print "MeetingInviteOrUpdate:" & olRule.Conditions.MeetingInviteOrUpdate & ":" & olRule.Conditions.MeetingInviteOrUpdate.Enabled & ":" & olRule.Conditions.MeetingInviteOrUpdate.ConditionType
Debug.Print "NotTo:" & olRule.Conditions.NotTo.Enabled & ":" & olRule.Conditions.NotTo.ConditionType
Debug.Print "OnlyToMe:" & olRule.Conditions.OnlyToMe.Enabled & ":" & olRule.Conditions.OnlyToMe.ConditionType
Debug.Print "OnLocalMachine:" & olRule.Conditions.OnLocalMachine & ":" & olRule.Conditions.OnLocalMachine.Enabled & ":" & olRule.Conditions.OnLocalMachine.ConditionType
Debug.Print "ToMe:" & olRule.Conditions.ToMe & ":" & olRule.Conditions.ToMe.Enabled & ":" & olRule.Conditions.ToMe.ConditionType
Debug.Print "subject:" & olRule.Conditions.Subject & ":" & olRule.Conditions.Subject.Enabled & ":" & olRule.Conditions.Subject.ConditionType & ":" & olRule.Conditions.Subject.Text
Debug.Print "SenderAddress:" & olRule.Conditions.SenderAddress & ":" & olRule.Conditions.SenderAddress.Enabled & ":" & olRule.Conditions.SenderAddress.ConditionType & ":" & olRule.Conditions.SenderAddress.Address
Debug.Print "SenderInAddressList:" & olRule.Conditions.SenderInAddressList & ":" & olRule.Conditions.SenderInAddressList.AddressList.Name
Debug.Print "ToOrCc:" & olRule.Conditions.ToOrCc & ":" & olRule.Conditions.ToOrCc.Enabled & ":" & olRule.Conditions.MeetingInviteOrUpdate.ConditionType
Set olRuleAcs = olRule.Actions
For i1 = 1 To olRule.Actions.Count
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMoveToFolder Then
Debug.Print "Move To Folder: " & olRule.Actions.MoveToFolder.Folder.folderPath
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionAssignToCategory Then
Debug.Print olRule.Name, ":", i1, ":", "Assign To Category: " & olRule.Actions.AssignToCategory.ActionType
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionCopyToFolder Then
Debug.Print olRule.Name, ":", i1, ":", "Copy To Folder: " & olRule.Actions.CopyToFolder.Folder.folderPath
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDeletePermanently Then
Debug.Print olRule.Name, ":", i1, ":", "DeletePermanently: " & olRule.Actions.DeletePermanently.ActionType & ":" & olRule.Actions.DeletePermanently.Enabled
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDesktopAlert Then
Debug.Print olRule.Name, ":", i1, ":", "DeletePermanently: " & olRule.Actions.DesktopAlert.ActionType & ":" & olRule.Actions.DesktopAlert.Enabled
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDelete Then
Debug.Print olRule.Name, ":", i1, ":", "Delete: " & olRule.Actions.Delete.ActionType & ":" & olRule.Actions.Delete.Enable
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionDefer Then
Debug.Print olRule.Name, ":", i1, ":", "Defer: "
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForward Then
Debug.Print olRule.Name, ":", i1, ":", "Forward: " & olRule.Actions.Forward.ActionType & ":" & olRule.Actions.Forward.Enabled; ":" & olRule.Actions.Forward.Enabled & ":Rep:" & olRule.Actions.Forward.Recipients.Count & ":1:" & olRule.Actions.Forward.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionImportance Then Debug.Print olRule.Name, ":", i1, ":", "Importance: "
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionForwardAsAttachment Then
Debug.Print olRule.Name, ":", i1, ":", "ForwardasAttachment: " & olRule.Actions.ForwardAsAttachment.ActionType & ":" & olRule.Actions.ForwardAsAttachment.Enabled & ":Rep:" & olRule.Actions.ForwardAsAttachment.Recipients.Count & ":1:" & olRule.Actions.ForwardAsAttachment.Recipients.Item(1).Address
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMarkAsTask Then
Debug.Print olRule.Name, ":", i1, ":", "MarkAsTask: " & olRule.Actions.MarkAsTask.FlagTo & ":" & olRule.Actions.MarkAsTask.Enabled & ":" & olRule.Actions.MarkAsTask.MarkInterval
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionMarkRead Then
Debug.Print olRule.Name, ":", i1, ":", "MarkRead: "
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionNewItemAlert Then
Debug.Print olRule.Name, ":", i1, ":", "NewItemAlert: " & olRule.Actions.NewItemAlert.ActionType & ":" & olRule.Actions.NewItemAlert.Enabled & ":Text:" & olRule.Actions.NewItemAlert.Text
End If
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionNotifyDelivery Then Debug.Print olRule.Name, ":", i1, ":", "NortifyDelivery:", olRule.Actions.NotifyDelivery.ActionType & ":" & olRule.Actions.NotifyDelivery.Enabled
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionFlagClear Then Debug.Print olRule.Name, ":", i1, ":", "FlagClear:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionFlagColor Then Debug.Print olRule.Name, ":", i1, ":", "FlagColor:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionClearCategories Then Debug.Print olRule.Name, ":", i1, ":", "ClearCategories:" & olRule.Actions.ClearCategories.ActionType & ":" & olRule.Actions.ClearCategories.Enabled
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionPlaySound Then Debug.Print olRule.Name, ":", i1, ":", "PlaySount:" & olRule.Actions.PlaySound.ActionType & ":" & olRule.Actions.PlaySound.Enabled & ":" & olRule.Actions.PlaySound.FilePath
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionPrint Then Debug.Print olRule.Name, ":", i1, ":", "Print:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionRedirect Then Debug.Print olRule.Name, ":", i1, ":", "Redirect:" & olRule.Actions.Redirect.ActionType & ":" & olRule.Actions.Redirect.Enabled & ":" & olRule.Actions.Redirect.Recipients.Count & ":" & olRule.Actions.Redirect.Recipients.Item(1).Address
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionRunScript Then Debug.Print olRule.Name, ":", i1, ":", "RunScript:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionSensitivity Then Debug.Print olRule.Name, ":", i1, ":", "Sensitivity:"
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionStop Then Debug.Print olRule.Name, ":", i1, ":", "Stop:" & olRule.Actions.Stop.ActionType & ":" & olRule.Actions.Stop.Enabled
If olRule.Actions.Item(i1).ActionType = Outlook.OlRuleActionType.olRuleActionUnknown Then Debug.Print olRule.Name, ":", i1, ":", "Unknown:"
Next i1
'https://msdn.microsoft.com/ja-jp/VBA/Outlook-VBA/articles/specifying-rule-conditions
'https://social.technet.microsoft.com/Forums/scriptcenter/en-US/f848fea4-e01f-4347-8524-a442a9aedf77/identify-outlook-move-rules-with-vbscript?forum=ITCG
Next
End Sub
Private Sub printArray(ByRef pArr As Variant)
Dim readString As Variant
If (IsArray(pArr)) Then 'check if the passed variable is an array
For Each readString In pArr
If TypeName(readString) = "String" Then 'check if the readString is a String variable
Debug.Print readString
End If
Next
End If
End Sub

#ほかにも
上のVBAはExecutionOrderが入っていないので
VBA Script that gets list of Outlook Rules using the Outlook Object Model

とかあります。

#このVBAの必要性
このVBAはレシピエントをルールに入れている場合に役立ちます。上のレシピエントは1名分しか出していませんが、For i =1 to Recipients.count みたいな感じでるーぷろ回して引き出せます。
これで名前に漏れがないかを確認することができます。また以前設定して忘れているルールなど、隠れたルールがないか、このVBAでわかるわけです。

#メインのまとめはこちら
OUTLOOK関連はなぜか自分のところで2番目に閲覧数の多いまとめでいかがOUTLOOKのメインのまとめになります。今回の仕訳ルールはメールに関する機能の一つで細かい部分です。

https://qiita.com/Q11Q/items/ac14d96c00e707de5d13
おかげさまで6000を超えました。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?