Outlook VBA マクロで分類 Categoriesの登録蛇足でExcelから複数分類のセット

detail.chiebukuro.yahoo.co.jp

＞メールを色分けして分類するために、既存の色分類項目ではなく、
＞新規作成で名前と色を設定したいと考えています。
＞おそらく、Categories.Addメソッドを使用するとは思うのですが苦戦しております。
＞
＞Categories オブジェクト (Outlook)
＞https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories
＞
＞Categories.Add メソッド (Outlook)
＞https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories.add

上記質問に反応してみた・・・
ここまで、調べているなら、もう既に解決済みかなぁ、、、と思いつつ、

OutlookVBA マクロで分類 Categoriesの登録にチャレンジ蛇足でExcelから複数分類のセット処理 - YouTube
https://youtu.be/jzZi5BdKpXE
目次
00:00 やりたいこと
00:50 1.単純にOutlookマクロで分類を追加してみた
03:22 2.同じ項目名を追加するとどうなるか？
03:57 3.分類項目名が存在したら・・の処理を入れる
08:48 4.蛇足単体テスト終了、次はExcelから複数登録？
13:24 5.あっ、増えすぎた分類項目を消したい時・・・

#OutlookVBA #ExcelVBA #VBA #Categories
#アウトルック #エクセル #マクロ #分類項目
#デバッグ #Debug

1.単純にOutlookマクロで分類を追加してみた
learn.microsoft.com
のコードを変更して、固定の値を書いてみた

' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories
'のコードを参考にして
Sub tset20230121_Category_追加のテスト()

    Dim objNameSpace As Outlook.NameSpace
    Dim objCategory  As Outlook.Category   'あれ今回、使ってないや・・
 
    ' Obtain a NameSpace object reference.
    Set objNameSpace = Application.GetNamespace("MAPI")
 
    ' Check if the Categories collection for the Namespace
    ' contains one or more Category objects.
    ' objNameSpace.Categories.Count
    '↑なるほど、これで分類のカウントがわかるのか、今回は置いといて
    
    '分類を追加してみる
    '  Categories.Add メソッド (Outlook)
    ' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories.add
    objNameSpace.Categories.Add "テスト分類名", olCategoryColorRed
    ' OlCategoryColor 列挙 (Outlook) ↑olCategoryColorRed 色定数が知りたい時
    ' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.olcategorycolor
    
    ' Clean up.
    Set objCategory = Nothing
    Set objNameSpace = Nothing
 
End Sub

03:22 ～
2.同じ項目名を追加するとどうなるか？
↑上のコードを二回実行すると(※同じ値を追加すると、どうなるのか？)

実行時エラー 80070057
分類項目名が重複しています。分類項目名は一意である必要があります。

まぁ、そうなるよね。

03:57 ～
3.分類項目名が存在したら・・の処理を入れる

やり方、いろいろ、ありますが、
存在チェックを単純に、
Set objCategory = objNameSpace.Categories("分類名の文字列")
で、取得する、
3.1 取得できなかったら、objNameSpace.Categories.Addで追加
3.2 取得できたら、 objCategory.Color 色だけ変える

この方向でコードを修正すると、

' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories
'のコードを参考にして
Sub tset20230121_Category_追加のテスト002()

    Dim str分類名 As String  'また日本語変数名かよ・・
    Dim n分類色 As Integer   '分類の色、今回ショートカットキーはテストしない

    '単純に入力、キャンセルチェックなし・・・
    str分類名 = InputBox("登録分類名？を入れて", "分類名", "テスト分類名")
    n分類色 = Val("0" & InputBox("色は？1:赤 5:緑 8:青 など", "色", "1")) '数値に変換
        ' OlCategoryColor 列挙 (Outlook) ↑olCategoryColorRed 色定数が知りたい時
        ' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.olcategorycolor

    'NameSpace 複数アカウント設定時、分類がどうなのか？気になるけど後日の課題かな・・
    Dim objNameSpace As Outlook.NameSpace
    Set objNameSpace = Application.GetNamespace("MAPI")
 
    '分類
    Dim objCategory  As Outlook.Category   '今回、存在チェックを兼ねて使用
    Set objCategory = Nothing  'エラーチェックのため初期化
    On Error Resume Next 'エラーを無視して次に行く、見つからなかった時の判断用
    Set objCategory = objNameSpace.Categories(str分類名)
    On Error GoTo 0 'すぐに戻そうぜ※意外と忘れがちなので、Resume Nextとセットで
 
    '分類 objCategory が↑存在しなければ   追加する
    If objCategory Is Nothing Then    '分類を追加してみる
        '  Categories.Add メソッド (Outlook)
        ' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories.add
        objNameSpace.Categories.Add str分類名, n分類色
    Else
        objCategory.Color = n分類色  '分類名が存在したので、色だけ変更
    End If
    
    ' Clean up.
    Set objCategory = Nothing
    Set objNameSpace = Nothing
 
End Sub

08:48 ～
4.蛇足単体テスト終了、次はExcelから複数登録？

Excelなど、分類登録の表を作り、連続登録かなぁ・・・

A列に分類名,B列に色を指定して、連続登録かな・・

Option Explicit

'Excel から Outlookの分類を追加する テスト
'A列の分類名 と B列の色 を 登録する(一方通行)
Sub tset20230121_Category_追加のテスト003()

    'Outlookの起動
    Dim oApp As Outlook.Application  'OutlookのApplication オブジェクトを入れる
    Set oApp = CreateObject("Outlook.Application") 'outlook起動をCreateObjectで
    
    'NameSpace 複数アカウント設定時、分類がどうなのか？気になるけど後日の課題かな・・
    Dim objNameSpace As Outlook.Namespace
    Set objNameSpace = oApp.GetNamespace("MAPI")
    '次は作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display)
    Dim objFolder As Outlook.Folder
    Set objFolder = objNameSpace.GetDefaultFolder(9) '予定
    objFolder.Display  '表示
    
    Dim objCategory  As Outlook.Category '分類オブジェクト
    
    Dim str分類名 As String  'また日本語変数名かよ・・
    Dim n分類色 As Integer   '分類の色、今回ショートカットキーはテストしない
    
    'A2から空白になるまで登録する
    Dim y As Long
    For y = 2 To 999 '
        str分類名 = Trim(Cells(y, "A").Text) 'A列の分類名
        n分類色 = Val("0" & Cells(y, "B"))   'B列の色
        If str分類名 = "" Then Exit For 'A列が空白になったら抜ける
        
       '分類の存在チェックと登録
       Set objCategory = Nothing  'エラーチェックのため初期化
       On Error Resume Next 'エラーを無視して次に行く、見つからなかった時の判断用
       Set objCategory = objNameSpace.Categories(str分類名)
       On Error GoTo 0 'すぐに戻そうぜ※意外と忘れがちなので、Resume Nextとセットで
    
       '分類 objCategory が↑存在しなければ   追加する
       If objCategory Is Nothing Then    '分類を追加してみる
           '  Categories.Add メソッド (Outlook)
           ' https://learn.microsoft.com/ja-jp/office/vba/api/outlook.categories.add
           objNameSpace.Categories.Add str分類名, n分類色
       Else
           objCategory.Color = n分類色  '分類名が存在したので、色だけ変更
       End If
    
    Next y

   
    ' Clean up.
    oApp.Quit '起動したアウトルックの終了
    Set oApp = Nothing
    Set objCategory = Nothing
    Set objNameSpace = Nothing
 
    MsgBox "処理終了、Outlookの分類を確認してください"
 
End Sub