共有メールボックスに受信したメールの件名に連番を付与するマクロ


コメントにて以下のご要望をいただきました。


共有メールボックスに受信される「指定のメールボックス」に、受信したメールの件名に連番を自動で発番していくマクロはありますでしょうか。 そもそも、共有メールボックスにマクロを入れるのは不可能なのでしょうか。


共有メールボックスに受信したメールについてマクロを実行する方法については「共有メールボックスの受信トレイに追加されたメールの添付ファイルを保存するマクロ」で解説した通りです。

連番を自動で発番するとなると、発番済みの番号を管理する必要が出てきます。
VBA では SaveSetting ステートメントで VBA 固有のレジストリ キーに設定を保存し、GetSetting 関数で設定した値を読み込むことができます。
マクロは以下のようになります。

' ここをトリプルクリックでマクロ全体を選択できます。
' 共有フォルダーのイベントを取得するためのオブジェクト
Dim WithEvents sharedInboxItems As Items
'
Private Sub Application_Startup()
     ' 共有メールボックスの SMTP アドレスを指定
     Const SHARED_USER = "shareduser@example.com"
     Dim recShared As Recipient
     Dim fldSharedInbox As Folder
     ' 共有メールボックスのユーザー情報を取得
     Set recShared = Session.CreateRecipient(SHARED_USER)
     recShared.Resolve
     ' 共有メールボックスの受信トレイを取得
     Set fldSharedInbox = Session.GetSharedDefaultFolder(recShared, olFolderInbox)
     Set sharedInboxItems = fldSharedInbox.Items
End Sub
'
' 共有フォルダーの受信トレイにアイテムが追加された際に発生するイベント
Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
     '
     Const APP_NAME = "OutlookLab"
     Const SEC_NAME = "SharedInboxCount"
     Const KEY_NAME = "LastCount"
     Dim iSeq As Integer
     Dim strPrefix As String
     '
     ' 必要に応じてここで条件指定
     '
     ' レジストリから連番を取得
     iSeq = CInt(GetSetting(APP_NAME, SEC_NAME, KEY_NAME, "0"))
     iSeq = iSeq + 1
     ' 件名に追加する文字列を生成
     strPrefix = "[" & iSeq & "] "
     ' 生成した文字列を懸命に追加
     Item.Subject = strPrefix & Item.Subject
     ' アイテムを保存
     Item.Save
     ' レジストリに連番を保存
     SaveSetting APP_NAME, SEC_NAME, KEY_NAME, iSeq
End Sub

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

コメントを残す

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

WordPress.com ロゴ

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

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中